T4088_Loop Through Tables Collect Data To Master Sheet

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

Sub Loop_Through_Tables_Collect_Data_To_Master_Sheet()
    Dim a, sh As Worksheet, tbl As ListObject, x As Byte, i As Long, m As Long, n As Long, lr As Long

    Application.ScreenUpdating = False
        For x = 1 To 2
            If x = 1 Then
                Set sh = ThisWorkbook.Worksheets(8)         'Mid-Year Worksheet
            Else
                Set sh = ThisWorkbook.Worksheets(15)        'End-Year Worksheet
            End If

            Set tbl = sh.ListObjects(1)
            If tbl.ListRows.Count >= 1 Then tbl.DataBodyRange.Delete
            sh.ListObjects(1).ListRows.Add

            For i = IIf(x = 1, 2, 9) To IIf(x = 1, 7, 14)
                With ThisWorkbook.Worksheets(i)
                    m = LastRow(.ListObjects(1), 2)
                    n = LastRow(sh.ListObjects(1), 2)
                    If m <> -1 Then
                        lr = IIf(n = -1, 5, n + 1)
                        a = .Range("C5:H" & m).Value
                        sh.ListObjects(1).DataBodyRange.Cells(lr - 4, 2).Resize(UBound(a, 1), UBound(a, 2)).Value = a
                    End If
                End With
            Next i

            If n <> -1 Then
                With sh.ListObjects(1).DataBodyRange.Cells(1).Resize(n - 4)
                    .Value = Evaluate("ROW(1:" & .Count & ")")
                End With
            End If
        Next x
    Application.ScreenUpdating = True

    MsgBox "Done...", 64
End Sub

Function LastRow(tbl As ListObject, col As Long)
    Dim rng As Range

    On Error GoTo Skipper
    Set rng = tbl.ListColumns(col).DataBodyRange.Find(What:="*", SearchDirection:=xlPrevious)
    LastRow = rng.Row
    Exit Function

Skipper:
    LastRow = -1
End Function