Insert two different ranges in a spreadsheet

[fontmar]

Morning everybody, I'm trying to crete a code for a specific action, but no idea on how to start.
I have a folder with different contracts in excel files: contract1.xlsm, mickeymouse.xlsm, goofy.xlsm, contract2.xlsm, etc. The contracts have two different formats: one with a range of 40 rows and another one with a range of 50 rows.
I created, in a new file, two different templates, one of 40 rows and one of 50 rows.
So i should have the macro reading all the contracts in the folder (can be more than hundred), count the number of rows in the file and copy the correct template on a spreadsheet.
Ex. Contract nr. 1 (contract1.xlsm) has 40 rows, so the macro will copy the template of 40 rows (from the sheet template40) and will paste it starting from cell A1 of the sheet "Contracts".
Contract nr. 2 (mickeymouse.xlsm) has 50 rows, so the macro will copy the template of 50 rows (from the sheet "template50") and will paste it starting from the cell A43 (40 rows of the first contract plus two blank row).
Contract nr. 3 (goofy.xlsm) has again 40 rows, so the macro will copy the template of 40 rows (from the sheet "template40") and will paste it starting from cell A96 (40 rows of the first contract, plus two blank rows, plus 50 rows of the second contract, plus two blank rows).
and so on...
is it something that can be done with one single macro.
i've tried, but no results...
thanks in advance for your coop.
marco

 

[portews]

So, just to be sure I understand...

You have the main workbook with the Contracts, template40 and template50 worksheets and the code in it. You want to open each workbook, see if it has 40 or 50 lines then copy the first 40 or 50 lines from the appropriate template to the last rows of the Contracts page, with 3 blank lines in between.

Do you want to copy any information from the pages you open, or only copy from the templates? Is there a specific number of columns that you're copying, or just all in rows 1-40 or 1-50?

 

[fontmar]

So, just to be sure I understand...

You have the main workbook with the Contracts, template40 and template50 worksheets and the code in it. You want to open each workbook, see if it has 40 or 50 lines then copy the first 40 or 50 lines from the appropriate template to the last rows of the Contracts page, with 3 blank lines in between.

Do you want to copy any information from the pages you open, or only copy from the templates? Is there a specific number of columns that you're copying, or just all in rows 1-40 or 1-50?

It should only copy from the templates an all in rows 1-40 or 1-50.
Thanks

 

[portews]

OK, try this:

Sub LoopAllExcelFilesInFolder()
[COLOR=#00ff00]'For: http://www.mrexcel.com/forum/excel-questions/973897-insert-two-different-ranges-spreadsheet.html[/COLOR]
[COLOR=#00ff00]
[/COLOR]
[COLOR=#00ff00]'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them[/COLOR]
[COLOR=#00ff00]'SOURCE (modiifed): https://www.thespreadsheetguru.com/the-code-vault/2014/4/23/loop-through-all-excel-files-in-a-given-folder[/COLOR]


Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

Dim lastrowContracts As Integer
Dim x As Integer

Dim ShContr As Worksheet

Set ShContr = ThisWorkbook.Sheets("Contracts")


[COLOR=#00ff00]'Optimize Macro Speed[/COLOR]
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual


[COLOR=#00ff00]'Retrieve Target Folder Path From User[/COLOR]
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)


    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With


[COLOR=#00ff00]'In Case of Cancel[/COLOR]
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings
[COLOR=#00ff00]
[/COLOR]
[COLOR=#00ff00]'Target File Extension (must include wildcard "*")[/COLOR]
  myExtension = "*.xlsm"


[COLOR=#00ff00]'Target Path with Ending Extention[/COLOR]
  myFile = Dir(myPath & myExtension)
y = 0
[COLOR=#00ff00]'Loop through each Excel file in folder[/COLOR]
  Do While myFile <> ""
    If myFile <> ThisWorkbook.Name Then
[COLOR=#00ff00]    'Set variable equal to opened workbook[/COLOR]
      Set wb = Workbooks.Open(Filename:=myPath & myFile)
    
[COLOR=#00ff00]    'Ensure Workbook has opened before moving on to next line of code[/COLOR]
      DoEvents
[COLOR=#00ff00]        'find the last row of the Contract sheet[/COLOR]
        lastrowContracts = ShContr.Cells(ShContr.Rows.Count, "A").End(xlUp).Row
        [COLOR=#00ff00]'find the last row of the current sheet[/COLOR]
        x = wb.ActiveSheet.Cells(wb.ActiveSheet.Rows.Count, "A").End(xlUp).Row
[COLOR=#00ff00]        'copy range from the template sheet based on x and paste it to the end of the Contract sheet[/COLOR]
        ThisWorkbook.Sheets("template" & x).Range("A1:A" & x).EntireRow.Copy _
            Destination:=ShContr.Cells(lastrowContracts + y, 1)
    y = 3
[COLOR=#00ff00]    'Ensure Workbook has closed before moving on to next line of code[/COLOR]
    wb.Close SaveChanges:=False
    DoEvents
    
    End If
[COLOR=#00ff00]     'Get next file name[/COLOR]
    myFile = Dir
    Loop


ResetSettings:
[COLOR=#00ff00]  'Reset Macro Optimization Settings[/COLOR]
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True


[COLOR=#00ff00]'Message Box when tasks are completed[/COLOR]
  MsgBox "Import Complete!"


End Sub

 

[fontmar]

Hi, sorry for my late reply, I was on a business trip.

I've tried the macro, but it stops on the first contract (Cell AE2) with a "Subscript out of range" message.

I realized that sheets of contracts a are password protected, but I unprotected and have the same results. Anything I can try?
Thanks

 

[portews]

Try stepping through the code using the F8 key and see what line it fails on and let me know.

This code is looking for the last row in column A to find out how long the contract is. Is that the right place for it to look? I'm not sure what cell AE2 has to do with it. Can you post a sample of your contract workbooks somewhere?

 

[fontmar]

Hi,
I've gone through the contracts and I've realized what's wrong.

First, there are some additional rows in white font, so I couldn't see them, with some codes and formulas. But I've noticed one more thing: the number of rows of the contract is always the same (49), some rows are just hidden.

At the moment the code should only select the number of rows from the contracts, copying them on the contracts sheet, plus 3 rows. With some additions:

a) an incremental number on each contract: nr.1 in the cell A1, nr.2 in the cell A52 (49 + 3 rows), nr.3 in the cell A104, etc.
b) I have two more macros (below) to list, on the sheet "Data", the name of each file and to count the number of files. Is it possible to integrate these two functions to the macro, to avoid to have 3 boxes?

Sub GetFileNames()
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "C:"
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & ""
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\*.xlsm"
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Loop
End If
End With
End Sub
___________________
Sub CountFiles()
Dim xFolder As String
Dim xPath As String
Dim xCount As Long
Dim xFiDialog As FileDialog
Dim xFile As String
Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
If xFiDialog.Show = -1 Then
xFolder = xFiDialog.SelectedItems(1)
End If
If xFolder = "" Then Exit Sub
xPath = xFolder & "\*xlsm"
xFile = Dir(xPath)
Do While xFile <> ""
xCount = xCount + 1
xFile = Dir()
Loop
Range("H1").Value = xCount
End Sub