Sub CollateAllWorkbooksInAFolder()
Dim strFolderPath As String
Dim fso As New FileSystemObject, fFolder As Folder, fFile As File
Dim wb As Workbook, sht As Worksheet, rng As Range
Dim tbl As ListObject
strFolderPath = "C:\test\" 'Change this to the folder your files are in
For Each sht In ThisWorkbook.Worksheets
For Each tbl In sht.ListObjects
If tbl.Name = "TBLdata" Then Exit For
Next
If Not tbl Is Nothing Then
If tbl.Name = "TBLdata" Then Exit For
End If
Next
If tbl Is Nothing Then
MsgBox "No table called TBLdata found in this workbook!"
Exit Sub
End If
If tbl.Name <> "TBLdata" Then
MsgBox "No table called TBLdata found in this workbook!"
Exit Sub
End If
If tbl.InsertRowRange Is Nothing Then
tbl.DataBodyRange.Delete
End If
Set fFolder = fso.GetFolder(strFolderPath)
For Each fFile In fFolder.Files
Set wb = Workbooks.Open(fFile.Path, False, True)
Set sht = wb.Sheets("Sheet1")
Set rng = sht.Range("A11:Y25")
If rng.Cells(rng.Rows.Count, 1).Value = "" Then
Set rng = rng.Resize(rng.Rows.Count - 1, rng.Columns.Count)
End If
If Not tbl.InsertRowRange Is Nothing Then
tbl.InsertRowRange.Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Else
tbl.ListRows.Add
tbl.ListRows(tbl.ListRows.Count).Range.Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
End If
Set rng = sht.Range("A28:Y42")
If rng.Cells(rng.Rows.Count, 1).Value = "" Then
Set rng = rng.Resize(rng.Rows.Count - 1, rng.Columns.Count)
End If
If Not tbl.InsertRowRange Is Nothing Then
tbl.InsertRowRange.Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Else
tbl.ListRows.Add
tbl.ListRows(tbl.ListRows.Count).Range.Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
End If
wb.Close False
Next
End Sub