Zkopírování obsahu všech buněk v Excelu

V rámci jednoho projektu jsem potřeboval zkopírovat obsah všech buněk ze všech listů sešitu na poslední list Total a to tak, aby byly data pod sebou. Navíc se v prvním řádku na jednotlivých listech nachází záhlaví, takže kopírování dat musí začít až od řádku 2. Pokud byste někdy něco podobného potřebovali, tady na to máte makro:


Sub Kopirovani()

    Dim wSheet As Worksheet
    Dim rCopy As Range
    Dim rPaste As Range
    Dim lngLastRow As Long
    Dim lngLastRowCons As Long
    Dim strConsTab As String
   
    strConsTab = "Total" 'Consolidation sheet tab name
   
    'Clear any existing data from the consolidation tab or else each _
    sheet in the work will keep appending to it each time the macro is run.
    lngLastRowCons = Sheets(strConsTab).Cells(Rows.Count, "A").End(xlUp).Row
    If lngLastRowCons > 1 Then
        Sheets(strConsTab).Range("A2:U" & lngLastRowCons).ClearContents
    End If
   
    For Each wSheet In Worksheets
        If wSheet.Name <> strConsTab Then
            With wSheet
                lngLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
                Set rCopy = .Range("A2:U" & lngLastRow)
            End With
           
            lngLastRowCons = Sheets(strConsTab).Cells(Rows.Count, "A").End(xlUp).Row
            lngLastRowCons = lngLastRowCons + 1
                                 
            Set rPaste = Sheets(strConsTab).Range("A" & lngLastRowCons)
            rCopy.Copy
            rPaste.PasteSpecial xlValues
            Application.CutCopyMode = False
        End If
    Next wSheet

End Sub