Merge tables from many separate workbooks - vba

Question

I want to merge specific contents of 2713 workbooks into a single worksheet. Lets say the individual files contain sales revenues for different sales outlets.
Each of the workbooks uses only 1 worksheet. Each of those worksheets contains one or more tables in identical format. Worksheets contain no fuctions whatsoever. This sample shows cells A1:E7
A1 contains the number of the specific outlet
A2 contains the reference date, e.g. 31.12.2014
A3:E3 contain the column headers: No.; Item; Revenue current period; Revenue previous period
A4:E10 contain the info I want transported to the new single file
A11:E11 contains the total amounts
Row 12 is blank
Another table with info for 31.12.2013 starts from row 13.
...
Most of the worksheets have more than just one table. All of them start like the one above. The tables have identical layout.
Unfortunately, the number of products varies a lot (1-250). For the example, I just assumed its 7 products. I don't need the row for headline or total.
How can I get those rows into a new single worksheet?
The outlet number in cell A1 on every sheet should be added in the cell to the right of the cells containing comment.
I want to avoid having to open the 2713 files one after the other in order to copy and paste the info in 2713 drag and drop moves into a merged worksheet.
I hope you can help or its gonna be a long weekend.
Best wishes,
Peter

Answer 1

I'm assuming here that when you say tables you mean defined tables of data.
The code below assumes that all tables are the same size (target and source tables).
There's no error checking and minimal testing - so check on some test workbooks first.
Sub GetTables()
Dim colWrkBks As Collection 'Contains path to all workbooks.
Dim vPath As Variant 'Current workbook path.
Dim wrkBk As Workbook 'Current workbook.
Dim wrksht As Worksheet 'Worksheet within wrkBk.
Dim oListObject As Object 'Tables within wrksht.
Dim oTargetTable As Object 'The table to hold all the data.
Dim sTmp As String
Dim sDirectory As String
'Make sure you have a table defined to place all the data in.
'Update worksheet and table name as required.
Set oTargetTable = ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1")
'Get full path of all workbooks in source folder.
'*Update directory and file extension as required
Set colWrkBks = New Collection
sDirectory = "C:\Users\Darren\Documents\Work\New folder\"
sTemp = Dir$(sDirectory & "*.xls*")
Do While Len(sTemp) > 0
colWrkBks.Add sDirectory & sTemp
sTemp = Dir$
Loop
'Open each workbook and copy the data from source table to target table.
For Each vPath In colWrkBks
Set wrkBk = Workbooks.Open(vPath, False)
'1 references the first worksheet - you can use "Sheet1" for a specific sheet name.
Set wrksht = wrkBk.Worksheets(1)
'Cycle through each table in the worksheet.
For Each oListObject In wrksht.ListObjects
oTargetTable.ListRows.Add
oListObject.DataBodyRange.Rows("1:" & oListObject.DataBodyRange.Rows.Count).Copy _
oTargetTable.DataBodyRange.Rows(oTargetTable.DataBodyRange.Rows.Count)
Next oListObject
wrkBk.Close False
Next vPath
End Sub