VBA : Combine multiple Workbooks(with mutiple Worksheets) into One Workbook with Data One Below The Other

Question

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

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)
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

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.
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.
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:

@James Z: Hi James. Thank you for showing me the edited version. Looks much better. Will format data in that format henceforth. — Ashok
@SJR : Hi SJR: Regarding your question : The sheets dont already exist in the Output file. The macro could be written in the Output file and run. And the data from all workbooks , can be combined to the Output file. — Ashok
Problems with your code is that you don't create a separate sheet in your results file, and you don't remove header row. I'll take a look later if you're still looking. — SJR
@SJR: Yes, that code doesn't do the job. It was something we were researching, but it didn't suit as it was built for a different requirement. Yes, we are still looking for this SJR. — Ashok

SJR SJR · Accepted Answer · 2020-09-18T16:46:39

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

VBA : Combine multiple Workbooks(with mutiple Worksheets) into One Workbook with Data One Below The Other

1 Answers