CODEWITHSUNDEEP
excelvba
Ashok
Ashok

Reputation: 69

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

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. (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 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 . i.e., 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.

This code combines all data from all workbooks and all worksheets into one single sheet, and the combining of data does not remove the headers etc.

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

Example Workbooks:

Upvotes: 0

Views: 2373

Answers (1)

SJR
SJR

Reputation: 23081

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

Upvotes: 2

Related Questions