Consolidate excel worksheet data into one sheet based on a list

[ea123]

Hello, I have this code below that copies data from all worksheets and copies it into one consolidated tab. My question is: is it possible to maintain a list on another tab called "List" and only select those worksheets that are part of that List to copy and consolidate data? Let us say I have 5 worksheets but I only want to copy and consolidate data from 2 of those called List 1 and List2 which are values maintained in tab called List? Thanks much!

Sub Consolidate()


Dim i As Integer
Dim w As Worksheet


On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a worksheet for consolidation of other tabs
Sheets(1).Name = "Consolidate"


' copy headings
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")


For Each w In ActiveWorkbook.Sheets
If w.Name <> "Consolidate" Then
Application.GoTo Sheets(w.Name).[a1]
Selection.CurrentRegion.Select
' Don't copy the headings
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets("Consolidate"). _
Cells(Rows.Count, 1).End(xlUp)(2)
End If
Next
End Sub

 

[Trebor76]

Largely untested, but this should do the job:

Option Explicit
Sub Consolidate()

    'Dim i As Integer
    Dim w As Worksheet
    Dim rngMyCell As Range
    Dim lngLastRow As Long
    
    On Error Resume Next
        Sheets(1).Select
        Worksheets.Add ' add a worksheet for consolidation of other tabs
        Sheets(1).Name = "Consolidate"
        
        ' copy headings
        Sheets(2).Activate
        Range("A1").EntireRow.Select
        Selection.Copy Destination:=Sheets(1).Range("A1")
        
        'Works from cell A2 down column A from the 'List' tab.  Change to suit if necessary.
        lngLastRow = Sheets("List").Cells(Rows.Count, "A").End(xlUp).Row
        For Each rngMyCell In Sheets("List").Range("A2:A" & lngLastRow)
            For Each w In ActiveWorkbook.Sheets
                If w.Name <> "Consolidate" Then
                    If w.Name = CStr(rngMyCell) Then
                        Application.Goto Sheets(w.Name).[a1]
                        Selection.CurrentRegion.Select
                        ' Don't copy the headings
                        Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
                        Selection.Copy Destination:=Sheets("Consolidate"). _
                        Cells(Rows.Count, 1).End(xlUp)(2)
                    End If
                End If
            Next w
        Next rngMyCell
    On Error GoTo 0
    
End Sub

Regards,

Robert

 

[ea123]

Thanks, Robert. This is getting very close. But it copies the first item in the list to the first row in consolidate and then copies the rest of the worksheets as per the list... any idea why that might be? Thanks!

Largely untested, but this should do the job:

Option Explicit
Sub Consolidate()

    'Dim i As Integer
    Dim w As Worksheet
    Dim rngMyCell As Range
    Dim lngLastRow As Long
    
    On Error Resume Next
        Sheets(1).Select
        Worksheets.Add ' add a worksheet for consolidation of other tabs
        Sheets(1).Name = "Consolidate"
        
        ' copy headings
        Sheets(2).Activate
        Range("A1").EntireRow.Select
        Selection.Copy Destination:=Sheets(1).Range("A1")
        
        'Works from cell A2 down column A from the 'List' tab.  Change to suit if necessary.
        lngLastRow = Sheets("List").Cells(Rows.Count, "A").End(xlUp).Row
        For Each rngMyCell In Sheets("List").Range("A2:A" & lngLastRow)
            For Each w In ActiveWorkbook.Sheets
                If w.Name <> "Consolidate" Then
                    If w.Name = CStr(rngMyCell) Then
                        Application.Goto Sheets(w.Name).[a1]
                        Selection.CurrentRegion.Select
                        ' Don't copy the headings
                        Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
                        Selection.Copy Destination:=Sheets("Consolidate"). _
                        Cells(Rows.Count, 1).End(xlUp)(2)
                    End If
                End If
            Next w
        Next rngMyCell
    On Error GoTo 0
    
End Sub

Regards,

Robert

 

[ea123]

I figured that out. Thanks. That solved my initial issue. Is it possible for this to open another workbook and copy the tabs from there instead of currently open workbook? Many thanks!

 

[Trebor76]

Yes it's quite possible to get the data from another workbook (there are plenty of examples on the net) but if you can't find a solution it's best to start a new thread as this is different from your original request which has now been addressed.

 

[ea123]

Thank you. I just posted my request on another thread: https://www.mrexcel.com/forum/excel...r-spreadsheet-reduce-re-work.html#post5156958

Yes it's quite possible to get the data from another workbook (there are plenty of examples on the net) but if you can't find a solution it's best to start a new thread as this is different from your original request which has now been addressed.