Excel VBA - to combine data of multiple worksheets from multiple workbooks

F Patel
F Patel used Ask the Experts™
on
Hello All,

I have workbook A, B, C, D etc in a folder...
each workbook has four sheets... sheet 1, sheet2 etc.

I want to combine the data from sheet1 of all workbooks into sheet1 of master workbook (which already exists) and similarly sheet2 etc.

The workbooks are from different users... they all have same headings.

Your help will be much appreciated.
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
IT System Administrator
Distinguished Expert 2017
Commented:
I believe this should do it for you. I don't have your exact setup so there might still be a few tweaks that need doing.
Sub LoopAllExcelFilesInFolder()
    Dim wb As Workbook, wbMain As Workbook
    Dim myPath As String
    Dim MyFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog
    Dim One, Two, Three, Four
    
    Set wbMain = ActiveWorkbook
    'Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    'Retrieve Target Folder Path From User
    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
    
    'In Case of Cancel
NextCode:
    myPath = myPath
    If myPath = "" Then GoTo ResetSettings
    
    'Target File Extension (must include wildcard "*")
    myExtension = "*.xls*" 'includes .xls, .xlsx, and .xlsm files
    
    'Target Path with Ending Extention
    MyFile = Dir(myPath & myExtension)
    
    'Loop through each Excel file in folder
    Do While MyFile <> ""
    'Set variable equal to opened workbook
    Set wb = Workbooks.Open(Filename:=myPath & MyFile)
    
    'Ensure Workbook has opened before moving on to next line of code
    DoEvents
    
    One = wb.Sheets("Sheet1").Range("I9").Value
    Two = wb.Sheets("Sheet2").Range("J10").Value
    Three = wb.Sheets("Sheet3").Range("H11").Value
    Four = wb.Sheets("Sheet4").Range("A12").Value
    
    Dim LastRow1
    LastRow1 = One.Cells(One.Rows.Count, 1).End(xlUp).Row
    Dim LastRow2
    LastRow2 = Two.Cells(Two.Rows.Count, 1).End(xlUp).Row
    Dim LastRow3
    LastRow3 = Three.Cells(Three.Rows.Count, 1).End(xlUp).Row
    Dim LastRow4
    LastRow4 = Four.Cells(Four.Rows.Count, 1).End(xlUp).Row
    
    wbMain.Sheets("Sheet1").Range("A" & LastRow1).Value = One
    wbMain.Sheets("Sheet2").Range("A" & LastRow2).Value = Two
    wbMain.Sheets("Sheet3").Range("A" & LastRow3).Value = Three
    wbMain.Sheets("Sheet4").Range("A" & LastRow4).Value = Four
    
    'Ensure Workbook has closed before moving on to next line of code
    DoEvents
    
    'Get next file name
    MyFile = Dir
    Loop
    
    'Message Box when tasks are completed
    MsgBox "Task Complete!"
    
ResetSettings:
    'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Open in new window

Author

Commented:
Thank you Mike

What is the purpose of .range (). value?
Mike in ITIT System Administrator
Distinguished Expert 2017

Commented:
To what line are you referring to?

When you are specifying a range it can be a single cell or multiple cells. The ".value" is just looking at the value(s) of the cell(s) specified by what it is attached to whether that is a Renge() object or a Cells() object.
TracyVBA Developer

Commented:
No comment has been added to this question in more than 21 days, so it is now classified as abandoned.

I have recommended this question be closed as follows:

Accept: Mike in IT (https:#a42440363)

If you feel this question should be closed differently, post an objection and the moderators will review all objections and close it as they feel fit. If no one objects, this question will be closed automatically the way described above.

broomee9
Experts-Exchange Cleanup Volunteer

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial