VBA：将多个工作簿（带有多个工作表）合并到一个工作簿中，数据一个在另一个下面

Question

I'm new to VBA. We are trying to do the following:

1. We have multiple workbooks, with 10 worksheets. Each worksheet has a specific name. As an example, we could call them Sheet 1 to Sheet 10.
   (though they are actually called QB-4.1 DA, QB-4.2 DA, QB-4.3 DA etc)
2. The format of all Sheet1's are same in all workbooks, The format of all Sheet2's are same in all workbooks etc.

We would like to write a VBA code which would do the following in a separate workbook called Output.xlsm

1. In Output.xlsm-> Sheet1:

   • Copy all data from Workbook1->Sheet1 including header.

   • Copy all data from Workbook2->Sheet1 not including header.

   • Copy all data from Workbook3->Sheet1 not including header. until Workbook n.

2. Same as above for all other sheets in Output.xlsm . ie, Output.xlsm-> Sheet2:

   • Copy all data from Workbook1->Sheet2 including header.

   • Copy all data from Workbook2->Sheet2 not including header.

   • Copy all data from Workbook3->Sheet2 not including header. until Workbook n.

3. Maintain the SheetNames.

We tried this code below which we researched, but it combines all data from all workbooks and all worksheets into one single sheet, and the combining of data does not remove the headers etc. Kindly discount this code below as we are beginners in VBA.

 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")
    
    'change folder path of excel files here
    
    Set dirObj = mergeObj.Getfolder("C:\consolidated\")
    
    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
    
        Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
    
        Application.CutCopyMode = False
    
        bookList.Close
    
    Next
    
    End Sub

We have tried to research many posts in StackOverFlow. Would you please guide us on how to complete this.

Example Workbooks:

• Workbook1

• Workbook2

• Output.xlsm

Answer 1

Can you try this?

I haven't looked as your files so some adjustments may be needed.

Sub simpleXlsMerger()
    
Dim bookList As Workbook, bFirst As Boolean, ws As Worksheet, wsO As Worksheet
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Dim rCopy As Range

Application.ScreenUpdating = False

Set mergeObj = CreateObject("Scripting.FileSystemObject")

'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("C:\consolidated\")
Set filesObj = dirObj.Files

For Each everyObj In filesObj
    Set bookList = Workbooks.Open(everyObj)
    For Each ws In bookList.Worksheets
        If Not bFirst Then
            Set wsO = ThisWorkbook.Worksheets.Add()
            wsO.Name = ws.Name
            Set rCopy=ws.range("A1").currentregion
            'Set rCopy = ws.Range("A1", ws.Range("IV" & Rows.Count)).End(xlUp)
        Else
            Set wsO = ThisWorkbook.Worksheets(ws.Name)
            Set rCopy=ws.range("A1").currentregion
            Set rCopy=rcopy.offset(1).resize(rcopy.rows.count-1)
            'Set rCopy = ws.Range("A2", ws.Range("IV" & Rows.Count)).End(xlUp)
        End If
        rCopy.Copy wsO.Range("A" & Rows.Count).End(xlUp)(2)
    Next ws
    bookList.Close
    bFirst = True
Next

End Sub