Forum Discussion

LaSta95's avatar
LaSta95
Copper Contributor
Apr 02, 2021

Combination of multiple excel workbooks with multiple sheets (not in a single sheet)

Hello! 🙂

I am struggeling right now with a task. I try to combine multiple excel workbooks, all with the same structure, so f.e. 5 sheets, each with the same headers, simultan over each workbook, into one workbook with multiple sheets.

So sheet 1 of wb2 is hung at the bottom of sheet1 of wb1 in a new master workbook, same for each other sheet. 
I do have multiple workbooks in multiple folders, all of the sheets have the same headers and I want to choose individually which workbooks I want to combine in the new "Master Workbook".

I am completly struggeling, I was able to combine each wb in a one sheet wb (it is not what I want nor need) and combine this single sheets, but I do not know how to accomplish my task. The best would be a VBA solution.

I would be greatful vor any help

Macros and VBA

24 Replies

  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Apr 02, 2021

    LaSta95 

    Do the worksheets have the same names in each of the workbooks?

    Do you want to process all worksheets in the workbooks, or should some sheets be skipped?

    • LaSta95's avatar
      LaSta95
      Copper Contributor
      Apr 06, 2021

      HansVogelaar 

      Hello! 🙂
      All sheets do have the same names and I do not want to skip any sheets.

       

      Thanks in advantage!

      • HansVogelaar's avatar
        HansVogelaar
        MVP
        Apr 06, 2021

        LaSta95 

        Try this.

        The target workbook should already have the 5 correctly named sheets.

        It should be the active workbook when you run the macro.

        You'll be prompted for each workbook to process.

        Click Cancel when you want to stop.

        Sub CombineWorkbooks()
    Dim wbkS As Workbook
    Dim wbkT As Workbook
    Dim wshS As Worksheet
    Dim wshT As Worksheet
    Dim strFile As String
    Dim lngS As Long
    Dim lngT As Long
    Application.ScreenUpdating = False
    Set wbkT = ActiveWorkbook
    Do
        strFile = Application.GetOpenFilename( _
            FileFilter:="Excel Workbooks (*.xls*),*.xls*", _
            Title:="Select a workbook to process. Click Cancel to stop")
        If strFile = "False" Then Exit Do
        Set wbkS = Workbooks.Open(Filename:=strFile)
        For Each wshS In wbkS.Worksheets
            Set wshT = wbkT.Worksheets(wshS.Name)
            lngS = 0
            lngT = 0
            On Error Resume Next
            lngS = wshS.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            lngT = wshT.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            On Error GoTo 0
            If lngS > 1 Then
                If lngT = 0 Then
                    wshS.Range("A1:A" & lngS).EntireRow.Copy Destination:=wshT.Range("A1")
                Else
                    wshS.Range("A2:A" & lngS).EntireRow.Copy Destination:=wshT.Range("A" & lngT + 1)
                End If
            End If
        Next wshS
        wbkS.Close SaveChanges:=False
    Loop
    Application.ScreenUpdating = True
End Sub

Resources