combine multiple workbook tables to one table on another workbook using vba

983 views Asked by At

I am wondering how I can copy the contents from all my workbooks called "Table1" (besides Headers), and Paste to a similarly formatted table called "Table2" on a Master workbook.

Here is the code I've been using to update the 3200 workbooks, I am hoping to use this template again.

I only want to copy the rows that are used (not headers), then add the next table's values to the bottom of the table.

"Table1" on each workbook logs some information every time the Workbook is Saved. I would like the Master "theFILE 1.1.xlsm" to have a Master table ("Table2") on sheet Master Edits.

Sub Macro2() 

Application.ScreenUpdating = False

Dim sFile As String
Dim wb As Workbook
Dim FileName1 As String
Dim FileName2 As String
Dim wksSource As Worksheet
Const scWkbSourceName As String = "theFILE 1.1.xlsm"

Set wkbSource = Workbooks(scWkbSourceName)
Set wksSource = wkbSource.Sheets("Sheet1") ' Replace Sheet1 with the sheet name

Const wsOriginalBook As String = "theFILE 1.1.xlsm"
Const sPath As String = "E:\theFILES\"

SourceRow = 5

Dim tbl As ListObject
Set tbl = ws.ListObjects("Table2")
Dim newrow As ListRow
Set newrow = tbl.ListRows.Add


Do While Cells(SourceRow, "D").Value <> ""

Sheets("Sheet1").Select

FileName1 = wksSource.Range("A" & SourceRow).Value
FileName2 = wksSource.Range("K" & SourceRow).Value

sFile = sPath & FileName1 & "\" & FileName2 & ".xlsm"

Set wb = Workbooks.Open(sFile)
'''Enter Code for Copy/Paste Tables 

Sheets("EDITS").Visible = True
Sheets("EDITS").Select
ActiveSheet.ListObjects("Table1").Range.Select
'need to omit the header
Selection.Copy

Windows("theFILE 1.1.xlsm").Activate
Sheets("Master Edits").Select
Range("Table2[DATES]").Select
With newrow

    ActiveSheet.Paste

End With

Windows("wb").Activate
Sheets("EDITS").Visible = False

Windows("theFILE 1.1.xlsm").Activate
Sheets("Sheet1").Select



'''CLOSE WORKBOOK W/O BEFORE SAVE
Application.EnableEvents = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.EnableEvents = True

SourceRow = SourceRow + 1 ' Move down 1 row for source sheet

Loop

End Sub

My problem is that I don't want the Headers. I need to add new rows for the next table's data.

Any and all help is greatly appreciated. Thanks!

0

There are 0 answers