Paste Value question

[linesy]

Good morning all,

I have the macro below that copies all of my worksheets into one consolidated sheet. Can any help me to change this macro so that it only copy.paste.values all of the sheets into the "Consolidated" sheet. Some of the formulas are causing issues when copied over.

Thanks so much for your time.



Sub CON()
Dim lr As Long, lr2 As Long, ws As Worksheet
Application.ScreenUpdating = False
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Consolidated"
Sheets("Sheet1").Rows("2:2").Copy Destination:=Sheets("Consolidated").Rows("1:1")
lr2 = Sheets("Consolidated").Cells(Rows.Count, "A").End(xlUp).Row
For Each ws In Worksheets
If ws.Name <> "Consolidated" Then
ws.Activate
If ws.Range("A1") <> "" Then
lr = Cells(Rows.Count, "A").End(xlUp).Row
Rows("3:" & lr).Copy Destination:=Sheets("Consolidated").Rows(lr2 + 1)
End If
End If
lr2 = Sheets("Consolidated").Cells(Rows.Count, "A").End(xlUp).Row
Next ws
Application.ScreenUpdating = True
End Sub

 

[JackDanIce]

Untested so suggest making a copy of your workbook before you try:

Sub CON_v1()

    Dim x       As Long
    Dim y       As Long
    Dim arr()   As Variant
    Dim wsCon   As Worksheet
    Dim ws      As Worksheet
    
    Application.ScreenUpdating = False

    With Sheets("Sheet1")
        x = .Cells(2, .Columns.count).End(xlToLeft).Column
        arr = .Cells(2, 1).Resize(, x).value
    End With

    Set wsCon = Sheets.add(after:=Sheets(Sheets.count))
    With wsCon
        .Name = "Consolidated"
        .Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)).value = arr
    End With
        
    For Each ws In Worksheets
        With ws
            If .Name <> wsCon.Name Then
                If .Cells(1, 1).value <> "" Then
                    'What happens if lr is less than 3? i.e. 2
                    'Original code copies rows 3:lr, so you would copy rows 3:2 with your existing code
                    x = .Cells(.rows.count, 1).End(xlUp).row
                    y = .Cells(1, .Columns.count).End(xlToLeft).Column
                    'This puts data from rows 3 to lr into an array and ignores anything in rows 1 and 2
                    arr = .Cells(3, 1).Resize(x - 2, y).value
                End If
            End If
        End With
        
        With wsCon
            .Cells(.rows.count, 1).End(xlUp).Offset(1).Resize(UBound(arr, 1), UBound(arr, 2)).value = arr
            Erase arr
        End With
    Next ws
    
    Application.ScreenUpdating = True
    
    Set wsCon = Nothing
    
End Sub