T4439_Loop Through Tables Collect Data To Master Sheet

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

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
            Set sh = ThisWorkbook.Worksheets(1)
            Set tbl = sh.ListObjects(1)
            If tbl.ListRows.Count >= 1 Then tbl.DataBodyRange.Delete
            sh.ListObjects(1).ListRows.Add

            For i = 2 To 13     'Sheets Index
                With ThisWorkbook.Worksheets(i)
                    m = LastRow(.ListObjects(1), 2)
                    n = LastRow(sh.ListObjects(1), 2)
                    If m <> -1 Then
                        lr = IIf(n = -1, 3, n + 1)
                        a = .Range("B3:E" & m).Value
                        sh.ListObjects(1).DataBodyRange.Cells(lr - 2, 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 - 2)
                    .Value = Evaluate("ROW(1:" & .Count & ")")
                End With
            End If
    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