Combine all same name worksheets into one worksheet

[sklee]

Dear VBA experts,

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

1st xlslx file with 4 sheets named "TODO", "DONE", "FUTURE", "PAST"
2nd xlslx file with 3 sheets named "TODO", "FUTURE", "TODAY"
3rd xlsx file with 3 sheets named "TODO", "DONE", "TOMORROW"

Then running a macro will open a new xlsx file and then have the sheets named as below with combined data ;

TODO (data of TODO sheet of 1st, 2nd, 3rd xlsx are combined)
DONE (data of DONE sheet of 1st, 3rd xlsx are combined)
FUTURE (data of FUTURE sheet of 1st, 2nd xlsx are combined)
PAST (data of PAST of 1st xlsx)
TODAY (data of TODAY of 2nd xlsx)
TOMORROW (data of TOMORROW of 3rd xlsx)

Could any one of you help?

Warm wishes,
sklee

 

[Anfinsen]

Dear VBA experts,

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

1st xlslx file with 4 sheets named "TODO", "DONE", "FUTURE", "PAST"
2nd xlslx file with 3 sheets named "TODO", "FUTURE", "TODAY"
3rd xlsx file with 3 sheets named "TODO", "DONE", "TOMORROW"

Then running a macro will open a new xlsx file and then have the sheets named as below with combined data ;

TODO (data of TODO sheet of 1st, 2nd, 3rd xlsx are combined)
DONE (data of DONE sheet of 1st, 3rd xlsx are combined)
FUTURE (data of FUTURE sheet of 1st, 2nd xlsx are combined)
PAST (data of PAST of 1st xlsx)
TODAY (data of TODAY of 2nd xlsx)
TOMORROW (data of TOMORROW of 3rd xlsx)

Could any one of you help?

Warm wishes,
sklee

Hi Sklee,
I use Kutools all the time for needs such as this. Check it out, it's and amazing add-in.

 

[sklee]

Hi Sklee,
I use Kutools all the time for needs such as this. Check it out, it's and amazing add-in.

Hello Anfinsen,
Thanks for yout tip. I know Kutools has 4 combine options, but I just would like to have the VBA code which only does the thing I just described.
Additionally I need to add it in my other VBA macro to run.
Thanks again for your expertise.
Sklee

 

[kevin9999]

See if the following comes close to what you want. It assumes that all the data you want to extract are in files that are already open:

there are 3 (or more than 3) xlsx files which are currently open

It may take a few attempts to get this just right, but here's a start.

Option Explicit
Sub Consolidate()
    Application.ScreenUpdating = False
    'Create a new Consolidated Data workbook
    Dim MySheets, wb1 As Workbook, i As Long
    MySheets = Array("TODO", "DONE", "FUTURE", "PAST", "TODAY", "TOMORROW")
    Set wb1 = Workbooks.Add
    Do Until i = 6
        Sheets.Add After:=Sheets(Sheets.Count)
        i = wb1.Sheets.Count
    Loop
    For i = 1 To wb1.Worksheets.Count
        Sheets(i).Name = MySheets(i - 1)
    Next i
    wb1.SaveAs ThisWorkbook.Path & "\Consolidated Data.xlsx"

    'Loop through each open workbook & extract data
    Dim wb As Workbook, x As String, j As Long, LRow As Long
    For Each wb In Application.Workbooks
        If wb.Name <> "Consolidated Data.xlsx" Then
            For i = 1 To wb.Sheets.Count
                x = wb.Sheets(i).Name
                For j = LBound(MySheets) To UBound(MySheets)
                    If x = MySheets(j) Then
                        LRow = wb1.Sheets(x).Cells(Rows.Count, "A").End(xlUp).Row + 1
                        wb.Sheets(x).Range("A1").CurrentRegion.Copy wb1.Sheets(x).Range("A" & LRow)
                    End If
                Next j
            Next i
        End If
    Next wb
    Application.ScreenUpdating = True
End Sub

 

[sklee]

See if the following comes close to what you want. It assumes that all the data you want to extract are in files that are already open:

It may take a few attempts to get this just right, but here's a start.

Option Explicit
Sub Consolidate()
    Application.ScreenUpdating = False
    'Create a new Consolidated Data workbook
    Dim MySheets, wb1 As Workbook, i As Long
    MySheets = Array("TODO", "DONE", "FUTURE", "PAST", "TODAY", "TOMORROW")
    Set wb1 = Workbooks.Add
    Do Until i = 6
        Sheets.Add After:=Sheets(Sheets.Count)
        i = wb1.Sheets.Count
    Loop
    For i = 1 To wb1.Worksheets.Count
        Sheets(i).Name = MySheets(i - 1)
    Next i
    wb1.SaveAs ThisWorkbook.Path & "\Consolidated Data.xlsx"

    'Loop through each open workbook & extract data
    Dim wb As Workbook, x As String, j As Long, LRow As Long
    For Each wb In Application.Workbooks
        If wb.Name <> "Consolidated Data.xlsx" Then
            For i = 1 To wb.Sheets.Count
                x = wb.Sheets(i).Name
                For j = LBound(MySheets) To UBound(MySheets)
                    If x = MySheets(j) Then
                        LRow = wb1.Sheets(x).Cells(Rows.Count, "A").End(xlUp).Row + 1
                        wb.Sheets(x).Range("A1").CurrentRegion.Copy wb1.Sheets(x).Range("A" & LRow)
                    End If
                Next j
            Next i
        End If
    Next wb
    Application.ScreenUpdating = True
End Sub

Hi kevin9999,
Thanks a billion kevin for your help! Oh sorry again that my question was not clear enough.
The nubmer of sheets and their names above are just samples, actuallly they are not fixed but changeable.
Sometime, they are 3,4,5,6,7,8,9,10 sheets etc. and their names are changed.
Simply put, I would like to combine any same name worksheet of all open xlsx files into in Consolidated Data.xlsx file, Just like the attached (combine_sheets.jpg) .
(CurrentRegion.Copy just does not copy data if empty column exist between them. I need to copy all data region including the empty columns.)
Sincerely yours,
sklee

 

[kevin9999]

The nubmer of sheets and their names above are just samples, actuallly they are not fixed but changeable.
Sometime, they are 3,4,5,6,7,8,9,10 sheets etc. and their names are changed.

The number of sheets doesn't matter, the following line of code loops through all sheets in each open workbook - irrespective of how many there are:

For i = 1 To wb.Sheets.Count

The names, however, are important. The following line of code looks for sheets with the exact names specified in the code. If they differ, you'll need to change it in this line:

MySheets = Array("TODO", "DONE", "FUTURE", "PAST", "TODAY", "TOMORROW")

As far as the non-contiguous ranges goes, try changing this line:

wb.Sheets(x).Range("A1").CurrentRegion.Copy wb1.Sheets(x).Range("A" & LRow)

to this:

wb.Sheets(x).UsedRange.Copy wb1.Sheets(x).Range("A" & LRow)

and see if that works for you.

 

[sklee]

Once again thanks for your sharing kevin999 and it seems that the data are combined in Consolidated Data.xlsx.
Like I said, the number of xlsx files and sheets, sheets names are not fixed but changable.
Instead of using MySheets = Array() where I should specify the sheet names, I would want to combine all the same name sheets of the xlsx files, "which are currently open".
(All the same name sheets have their own format, so I want the combined sheets to keep that format (like column width etc.) as well)
I think I am almost there

 

[kevin9999]

Instead of using MySheets = Array() where I should specify the sheet names, I would want to combine all the same name sheets of the xlsx files, "which are currently open".

This is significantly different from what you asked for in your initial post. I did say that you needed to specify the sheet names:

The following line of code looks for sheets with the exact names specified in the code. If they differ, you'll need to change it in this line:

MySheets = Array("TODO", "DONE", "FUTURE", "PAST", "TODAY", "TOMORROW")

however, you seem to be asking that the code should determine the names of all sheets, in all open files, at run time to enable their consolidation? That would not only require considerably more coding, it is also (potentially) fraught with problems - what if another xlsx file happened to be left open inadvertently? If that's the way you want to go, I suggest you start a new thread with your full intentions clearly articulated from the start.