Consolidate data from multiple sheets except one worksheet

[strongman86]

Hi guys,

I got this code working, but I need to add another worksheet which code would ignore (sheet called "Data"). Can you please fix code:

Sub Consolidate()

    Dim arr()   As Variant
    Dim ws      As Worksheet
    Dim wMast   As Worksheet
    Dim x       As Long
    Dim y       As Long
        
    Set wMast = Sheets("master")
    
    Application.ScreenUpdating = False
    
    For Each ws In ActiveWorkbook.Worksheets
        With ws
            If .Name <> wMast.Name Then
                x = .Cells(.Rows.Count, 25).End(xlUp).Row
                y = .Cells(x, .Columns.Count).End(xlToLeft).Column
                arr = .Cells(x, 1).Resize(, y).Value
                wMast.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, UBound(arr, 2)).Value = arr
                Erase arr
            End If
        End With
    Next ws
    
    Application.ScreenUpdating = True
    
    Set wMast = Nothing
    
End Sub

 

[JoeMo]

untested, but try modifying a single line:

If .Name <> wMast.Name and .Name <> "Data" Then

 

[dmt32]

Hi,
try this update to your code & see id does what you want

Sub Consolidate()

    Dim arr()   As Variant, IgnoreSheet As Variant
    Dim ws      As Worksheet, wMast  As Worksheet
    Dim x       As Long, y      As Long
    
    Set wMast = ThisWorkbook.Worksheets("master")
 
    IgnoreSheet = Array(wMast.Name, "Data")
 
    Application.ScreenUpdating = False
 
    For Each ws In ActiveWorkbook.Worksheets
        With ws
            If IsError(Application.Match(.Name, IgnoreSheet, 0)) Then
                x = .Cells(.Rows.Count, 25).End(xlUp).Row
                y = .Cells(x, .Columns.Count).End(xlToLeft).Column
                arr = .Cells(x, 1).Resize(, y).Value
                wMast.Cells(wMast.Rows.Count, 1).End(xlUp).Offset(1).Resize(, UBound(arr, 2)).Value = arr
                Erase arr
            End If
        End With
    Next ws
 
    Application.ScreenUpdating = True
 
    Set wMast = Nothing
 
End Sub

You can add to the Ignore array as required

Dave

 

[strongman86]

Hi,
try this update to your code & see id does what you want

Sub Consolidate()

    Dim arr()   As Variant, IgnoreSheet As Variant
    Dim ws      As Worksheet, wMast  As Worksheet
    Dim x       As Long, y      As Long
   
    Set wMast = ThisWorkbook.Worksheets("master")
 
    IgnoreSheet = Array(wMast.Name, "Data")
 
    Application.ScreenUpdating = False
 
    For Each ws In ActiveWorkbook.Worksheets
        With ws
            If IsError(Application.Match(.Name, IgnoreSheet, 0)) Then
                x = .Cells(.Rows.Count, 25).End(xlUp).Row
                y = .Cells(x, .Columns.Count).End(xlToLeft).Column
                arr = .Cells(x, 1).Resize(, y).Value
                wMast.Cells(wMast.Rows.Count, 1).End(xlUp).Offset(1).Resize(, UBound(arr, 2)).Value = arr
                Erase arr
            End If
        End With
    Next ws
 
    Application.ScreenUpdating = True
 
    Set wMast = Nothing
 
End Sub

You can add to the Ignore array as required

Dave

Works perfectly. Thanks Dave.

 

[dmt32]

welcome glad we were able to help & appreciate feedback

Dave