Combine all same name worksheets into each same name worksheet

[sklee]

Dear VBA gurus,

I would like to combine all data of each same name worksheet of all open files into the corresponding same name worksheets of a new file.
For example, there are 3 (or more than 3) xlsx files which are currently open ;

1st xlslx file with 1 sheet (or more) such as "A" etc.
2nd xlslx file with 2 sheets (or more) such as "A", "B" etc.
3rd xlsx file with 2 sheets (or more) such as "B", "C" etc.
...
* the number and name of the sheets are changeable.

Then running VBA will open a new xlsx file (such as Consolidated Data.xlsx) and then create the same name sheets with combined data, as attached (combine_sheets.jpg)

sheet A -> all data of sheet A of 1st, 2nd xlsx
sheet B -> all data of sheet B of 2nd, 3rd xlsx
sheet C -> all data of sheet C of 3rd xlsx
…

Could any one of you help?

Warm wishes,
sklee

 

[jkpieterse]

This seems to do it:

Option Explicit

Sub CombineAllSheets()
    Dim wb As Workbook
    Dim newWb As Workbook
    Dim sht As Worksheet
    Dim pasteSht As Worksheet
    Set newWb = Workbooks.Add(xlWorksheet)
    For Each wb In Workbooks
        If wb.Name <> newWb.Name Then
            For Each sht In wb.Worksheets
                On Error Resume Next
                Set pasteSht = Nothing
                Set pasteSht = newWb.Worksheets(sht.Name)
                On Error GoTo 0
                If pasteSht Is Nothing Then
                    Set pasteSht = newWb.Worksheets.Add(, newWb.Worksheets(newWb.Worksheets.Count))
                    pasteSht.Name = sht.Name
                End If
                sht.UsedRange.Copy
                With pasteSht
                    If .Range("A1").Value = "" Then
                        .Range("A" & .Rows.Count).End(xlUp).PasteSpecial xlPasteValuesAndNumberFormats
                    Else
                        .Range("A" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    End If
                End With
            Next
        End If
    Next
End Sub