T3973_Collate Data From Overtime Worksheets

https://excel-egy.com/forum/t3973
---------------------------------

Sub Collate_Data_From_Overtime_Worksheets()
    Dim aSheets(), aLast(), i%, x%, m%: m = 3

    Application.ScreenUpdating = False
        For i = 3 To Sheets.Count
            x = i - 2
            ReDim Preserve aSheets(1 To x)
            ReDim Preserve aLast(1 To x)
            aSheets(x) = Sheets(i).Name
            aLast(x) = Application.Max(Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row, 8) - 7
        Next i

        With ThisWorkbook.Worksheets("ALL")
            .Range("A3").CurrentRegion.Offset(2).ClearContents

            For i = LBound(aSheets) To UBound(aSheets)
                .Range("A" & m).Resize(aLast(i), 34).Value = Sheets(aSheets(i)).Range("A8").Resize(aLast(i), 34).Value
                m = m + aLast(i)
            Next i
        End With
    Application.ScreenUpdating = True
End Sub