Automate my recurring work

[Pradeepkundur]

i have to copy data from many workbooks and paste it in one Master file (One after the other/), range will vary from one work book to other work book but all starts in sheet2 row 10), all workbooks and master data file saved in one folder

Kindly help to run this with macro

 

[Mentor82]

Re: need to help to automate my recurring work

Hi,
In order to give you a hand I'd need to know more details.
What do you mean the range may vary - can be different no rows but the same no of columns in each workbook or the no of columns may vary too? Is the no of columns a constant qty?
How to distinguish between master workbook and another workbooks? Has the master file got a specific name?
The data starts from row 10. Is row 9 fill in with any data too or not? Is the row 10 a header row or first row with data?
Regards,
Sebastian

 

[Pradeepkundur]

Re: need to help to automate my recurring work

Hi Sebastian,

Thanks for the reply,
Row range will vary, number of rows may vary in each workbook but the Columns will remain same,
Other workbooks have different names EUR Sheet1, USD Sheet1, GBPsheet1,like this will be few more workbooks (Worksheet name will be-Current month Summary-for all worksheets.)
Master data can be named as ConsolidatedMaster file
The data starts from row 10 in every workbook and from row 1-row 9 has data like date, time, region, that can be ignored.
Row 10 has a headline like Customer Id, Customer name, Contract num, booking date, Maturity date.. so on.
Actual data start with row 11, but row 10 required as one time.

Please help me on this.

Regards
Pradeep

 

[Mentor82]

Re: need to help to automate my recurring work

Hi Pradeep,
Here I've prepared the code for you. This code you have to copy to the module in your Master workbook. The code works only from Master workbook - it imports the data from other files. If you need to have it worked from another workbook instead of Master one, let me know so I modify the code accordingly.
What you have to do is:
1. Copy this code to the Module in Master workbook
2. Open the Master workbook and within the workbook you have to turn on a reference in VBA named "Microsoft Scripting Runtime" [open VBA alt+F11\Tools\References find on the list Microsoft Scripting Runtime and mark it]
3. Adjust the constant values in the code (see my comments in the code) according to your needs
4. Assign the macro I wrote for you to the button and have fun

Sub ImportData2Master_main()
    Dim wbMaster As Workbook
    Dim wb2CopyFrom As Workbook
    Dim FSO As Scripting.FileSystemObject
    Dim cFolder As Folder
    Dim cFile As File
    Dim cFiles As Files
    Dim intLastRowMasterWb&
    Dim intLastRowProcessedWb&
    Dim intRowOffset&
    
    On Error GoTo ErrorHandler
    
    'Set the main folder which includes files which includes data to import
    Const sMainFolderDir$ = "C:\Users\Sebastian\Desktop\FilesToImport"
    
    'Set the number of worksheet in Master File where to import the data
    Const wsSHEET2COPYTO% = 1
    
    'Set the number of worksheet of import files from which the data will be imported
    Const wsSHEET2COPYFROM% = 2
    
    'Set the string range of first cell of the header in the master file
    Const sHEADER_FIRST_CELL_MASTERFILE$ = "A1"
    
    'Set the string of first cell on the header in the import files
    Const sHEADER_FIRST_CELL_PROCESSEDFILE$ = "A10"
    
    'Set the constant no of columns which includes data for the import
    Const int_NO_HEADER_COLUMNS% = 3
    
    Set wbMaster = ThisWorkbook
    Set FSO = New Scripting.FileSystemObject
    Set cFolder = FSO.GetFolder(sMainFolderDir)
    Set cFiles = cFolder.Files
    
    intLastRowMasterWb = 0
    intLastRowProcessedWb = 0
    intRowOffset = 0
    
    Application.ScreenUpdating = False
    
    intLastRowMasterWb = wbMaster.Worksheets(wsSHEET2COPYTO).Cells(Cells.Rows.Count, Range(sHEADER_FIRST_CELL_MASTERFILE).Column).End(xlUp).Row
    
    'clear all previosly imported data before re-importing it from worksheets
    wbMaster.Worksheets(wsSHEET2COPYTO).Range(Range(sHEADER_FIRST_CELL_MASTERFILE), Range(sHEADER_FIRST_CELL_MASTERFILE).Offset(intLastRowMasterWb - 1, int_NO_HEADER_COLUMNS - 1)).Clear
    
    
    For Each cFile In cFiles
        If (cFile.Name <> wbMaster.Name And cFile.Name Like "*" & wbMaster.Name = False) And (LCase(Right(cFile.Name, 3)) = "xls" Or LCase(Right(cFile.Name, 4)) = "xlsx" Or LCase(Right(cFile.Name, 4)) = "xlsm") Then
                Set wb2CopyFrom = Workbooks.Open(sMainFolderDir & "\" & cFile.Name)
                
                intLastRowMasterWb = wbMaster.Worksheets(wsSHEET2COPYTO).Cells(Cells.Rows.Count, Range(sHEADER_FIRST_CELL_MASTERFILE).Column).End(xlUp).Row
                intLastRowProcessedWb = wb2CopyFrom.Worksheets(wsSHEET2COPYFROM).Cells(Cells.Rows.Count, Range(sHEADER_FIRST_CELL_PROCESSEDFILE).Column).End(xlUp).Row
                                
                If intLastRowMasterWb = 1 Then
                     intRowOffset = 0
                Else
                    intRowOffset = 1
                End If
                
                wb2CopyFrom.Worksheets(wsSHEET2COPYFROM).Range(Range(sHEADER_FIRST_CELL_PROCESSEDFILE).Offset(intRowOffset, 0), Range(sHEADER_FIRST_CELL_MASTERFILE).Offset(intLastRowProcessedWb - 1, int_NO_HEADER_COLUMNS - 1)).Copy Destination:=wbMaster.Worksheets(wsSHEET2COPYTO).Cells(intLastRowMasterWb + intRowOffset, Range(sHEADER_FIRST_CELL_MASTERFILE).Column)
                wb2CopyFrom.Close
                
        End If
    Next cFile
    
    MsgBox "Done"
    
clearance:
    On Error Resume Next
    Set wbMaster = Nothing
    Set FSO = Nothing
    Set cFolder = Nothing
    Set cFiles = Nothing
    Application.ScreenUpdating = True
    
    Exit Sub
ErrorHandler:
    Debug.Print "Error: "
    Resume clearance
    
End Sub


[CODE\]

 

[Pradeepkundur]

Re: need to help to automate my recurring work

Thank you Very much for the replay Sebastian,

i was getting many error while running this code, complie error for FSO, cFolder, cFiles, etc...

However, what i understood from the code is, this will run and copy all the workbooks data and will copy in masterfile in different sheets,
but i want to copy all the workbooks data in to sheet1 in masterfile, (workbooks data one after the other, Example if workbook1 data ends at row 105 in masterfile the next workbook data should copy in masterfile row 106 without header)
in masterfile header required in one time,(for the first time).
Could you please help me on this.

Thanks in advance.

 

[Mentor82]

Re: need to help to automate my recurring work

Hi,
You get FSO error because you have to turn on the microsoft scripting rurntime reference in the master workbook where you have the macro (see point 2 below how to do that). You also get cFolder error because it's a part of FSO of which reference is not turned on.
Each time you run the macro it copies the data from workbooks located at Const sMainFolderDir$ = "C:\Users\Sebastian\Desktop\FilesToImport" from sheet number Const wsSHEET2COPYFROM% = 2 from this range on Const sHEADER_FIRST_CELL_PROCESSEDFILE$ = "A10" to master file (the one you've run the macro). All data is copied to master file sheet number
Const wsSHEET2COPYTO% = 1

1. Copy this code to the Module in Master workbook
2. Open the Master workbook and within the workbook you have to turn on a reference in VBA named "Microsoft Scripting Runtime" [open VBA alt+F11\Tools\References find on the list Microsoft Scripting Runtime and mark it]
3. Adjust the constant values in the code (see my comments in the code) according to your needs

Let me know if you successfully turne on the reference. If not, I'll change the code a little bit replacing early binding with late binding. As the result of.that the reference will no lomger be needed.

Regards,
Sebastian

 

[Mentor82]

Re: need to help to automate my recurring work

Hi Pradeep,
I've changed the early binding to late binding so you no longer have to turn on the reference. Check out the below code:
What you have to do is:
1. Copy this code to the module in your Master workbook
2. Set your folder directory which includes workbook of which data has to be imported: [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Const sMainFolderDir$ = "C:\Users\Sebastian\Desktop\FilesToImport"
3. Set the no of worksheet in Master workbook to which all workbooks data will be imported: [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Const wsSHEET2COPYTO% = 1
4. Set the no of worksheet from which the data will be copied to the Master one: [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Const wsSHEET2COPYFROM% = 2
5. Here set the address of first header cell in worksheet in master workbook: [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Const sHEADER_FIRST_CELL_MASTERFILE$ = "A1" ( in this case data will be imported to A1 on - A1 will be a header row)
6. Here set the address of the first header cel in workbooks where data to copy starts: [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Const sHEADER_FIRST_CELL_PROCESSEDFILE$ = "A10" (A10 is a header)
7. Set the no of columns to with data to be copied: [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Const int_NO_HEADER_COLUMNS% = 3 (in this case 3 columns with data will be copied to master workbook)[/FONT][/FONT][/FONT][/FONT][/FONT][/FONT]

let me know if that works . It works on my lap top so it has to work on yours too

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub ImportData2Master_main()
Dim wbMaster As Workbook
Dim wb2CopyFrom As Workbook
Dim FSO As Object
Dim cFolder As Object
Dim cFile As Object
Dim cFiles As Object
Dim intLastRowMasterWb&
Dim intLastRowProcessedWb&
Dim intRowOffset&[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]On Error GoTo ErrorHandler[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]'Set the main folder which includes files which includes data to import
Const sMainFolderDir$ = "C:\Users\Sebastian\Desktop\FilesToImport"[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]'Set the number of worksheet in Master File where to import the data
Const wsSHEET2COPYTO% = 1[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]'Set the number of worksheet of import files from which the data will be imported
Const wsSHEET2COPYFROM% = 2[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]'Set the string range of first cell of the header in the master file
Const sHEADER_FIRST_CELL_MASTERFILE$ = "A1"[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]'Set the string of first cell on the header in the import files
Const sHEADER_FIRST_CELL_PROCESSEDFILE$ = "A10"[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]'Set the constant no of columns which includes data for the import
Const int_NO_HEADER_COLUMNS% = 3[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Set wbMaster = ThisWorkbook
Set FSO = CreateObject("Scripting.FileSystemObject")
Set cFolder = FSO.GetFolder(sMainFolderDir)
Set cFiles = cFolder.Files[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]intLastRowMasterWb = 0
intLastRowProcessedWb = 0
intRowOffset = 0[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Application.ScreenUpdating = False[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]intLastRowMasterWb = wbMaster.Worksheets(wsSHEET2COPYTO).Cells(Cells.Rows.Count, Range(sHEADER_FIRST_CELL_MASTERFILE).Column).End(xlUp).Row[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]'clear all previosly imported data before re-importing it from worksheets
wbMaster.Worksheets(wsSHEET2COPYTO).Range(Range(sHEADER_FIRST_CELL_MASTERFILE), Range(sHEADER_FIRST_CELL_MASTERFILE).Offset(intLastRowMasterWb - 1, int_NO_HEADER_COLUMNS - 1)).Clear[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
For Each cFile In cFiles
If (cFile.Name <> wbMaster.Name And cFile.Name Like "*" & wbMaster.Name = False) And (LCase(Right(cFile.Name, 3)) = "xls" Or LCase(Right(cFile.Name, 4)) = "xlsx" Or LCase(Right(cFile.Name, 4)) = "xlsm") Then
Set wb2CopyFrom = Workbooks.Open(sMainFolderDir & "\" & cFile.Name)[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]intLastRowMasterWb = wbMaster.Worksheets(wsSHEET2COPYTO).Cells(Cells.Rows.Count, Range(sHEADER_FIRST_CELL_MASTERFILE).Column).End(xlUp).Row
intLastRowProcessedWb = wb2CopyFrom.Worksheets(wsSHEET2COPYFROM).Cells(Cells.Rows.Count, Range(sHEADER_FIRST_CELL_PROCESSEDFILE).Column).End(xlUp).Row[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]If intLastRowMasterWb = 1 Then
intRowOffset = 0
Else
intRowOffset = 1
End If[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]wb2CopyFrom.Worksheets(wsSHEET2COPYFROM).Range(wb2CopyFrom.Worksheets(wsSHEET2COPYFROM).Range(sHEADER_FIRST_CELL_PROCESSEDFILE).Offset(intRowOffset, 0), wb2CopyFrom.Worksheets(wsSHEET2COPYFROM).Range(sHEADER_FIRST_CELL_MASTERFILE).Offset(intLastRowProcessedWb - 1, int_NO_HEADER_COLUMNS - 1)).Copy Destination:=wbMaster.Worksheets(wsSHEET2COPYTO).Cells(intLastRowMasterWb + intRowOffset, Range(sHEADER_FIRST_CELL_MASTERFILE).Column)
wb2CopyFrom.Close[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]End If
Next cFile[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]MsgBox "Done"[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]clearance:
On Error Resume Next
Set wbMaster = Nothing
Set FSO = Nothing
Set cFolder = Nothing
Set cFiles = Nothing
Application.ScreenUpdating = True[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Exit Sub
ErrorHandler:
Debug.Print "Error: "
Resume clearance[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]End Sub

[CODE/]
[/FONT]