Not able to merge the data of multiple worksheets from multiple excels with same header of all the Individual sheets

Question

I am new to VBA, Gone thourgh the many areas to understand my need but having some issues.

Goal:

I have 3 sheets like sheet1, sheet2 and sheet3 for all the files(20 excelsheets), It’s have same in all the spreadsheets. Now I have another file called Master where I need to merge all the sheets. Not in single sheets in master but for Master sheet also I have 3 sheets(Sheet1,sheet2 and sheet3) as the heading is same for all the sheets

Problem i am facing

The below code is merging only first sheet called sheet1 but not other sheets sheet2 and sheet3

 Sub simpleXlsMerger()
    Dim bookList As Workbook
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
    Application.ScreenUpdating = False
    Set mergeObj = CreateObject("Scripting.FileSystemObject")
    Set dirObj = mergeObj.Getfolder("C:\Excel\Path")

    Set filesObj = dirObj.Files
    For Each everyObj In filesObj

    Set bookList = Workbooks.Open(everyObj)

    Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
    ThisWorkbook.Worksheets(1).Activate

    'Do not change the following column. It's not the same column as above
    Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
    Application.CutCopyMode = False
    bookList.Close
    Next
 End Sub

DisplayName DisplayName · Accepted Answer · 2018-07-13T06:35:16

you have to add a loop to go thorugh those three sheets foe every opened workbook

try this (not tested)

Option Explicit

Sub simpleXlsMerger()
    Dim bookList As Workbook
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
    Dim iSht As Long
    Dim masterWb As Workbook

    Set masterWb = ThisWorkbook
    Application.ScreenUpdating = False
    Set mergeObj = CreateObject("Scripting.FileSystemObject")
    Set dirObj = mergeObj.Getfolder("C:\Excel\Path")
    Set filesObj = dirObj.Files
    For Each everyObj In filesObj
        With Workbooks.Open(everyObj) ' open and reference current workbook
            For iSht = 1 To 3 ' loop through sheets index from 1 to 3
                With .Sheets(iSht) ' reference referenced workbook sheet with current index
                    .Range("A2:IV" & .Cells(.Rows.Count, 1).End(xlUp).Row).Copy Destination:=masterWb.Sheets(iSht).Cells(masterWb.Sheets(iSht).Rows.Count, 1).End(xlUp)
                End With
            Next
            .Close
        End With
    Next
End Sub

Not able to merge the data of multiple worksheets from multiple excels with same header of all the Individual sheets

1 Answers