Excel VBA - Copy data from multiple sheets into a table

[mdw8189]

I'd like to be able to copy data from multiple sheets into a table without deleting the table's formatting. The data being copied from each sheet will always contain 6 columns, but the number of rows in each sheet will vary. Additionally, I do not want the first two rows of each sheet to be copied. I'd like the data from all of the copied sheets to be pasted one after another into a single preexisting table starting at B2, without deleting the table's formatting. Any suggestions? Thanks

 

[Skybluekid]

Are you able to post a sample of data from each worksheet, inc tab name, and the table? Also, is it just the new data that needs to be added to the table? If so, how is the new data identified?

 

[Herakles]

This may work for you.

Try it on a copy of your workbook.

Place the code in a standard code module and run the subCopyDataFromMultipleSheetsIntoATable procedure.

Substitute the word 'Tables' in the line below with the name of the worksheet containing your table.
Set Ws = Worksheets("Tables")

Substitute the word 'tblCompany' in the line below with the name of the table.
Set objTable = Ws.ListObjects("tblCompany")

Substitute the words beginning 'Source' in the line below with the name of the worksheets
from where the data is to be sourced. Worksheet names to be seperated by commas.
strWorksheets = "Source1,Source2,Source3,Source4"

Public Sub subCopyDataFromMultipleSheetsIntoATable()
Dim Ws As Worksheet
Dim objTable As Object
Dim rng As Range
Dim strWorksheets As String
Dim arrSheets() As String
Dim i As Integer

    ActiveWorkbook.Save

    Set Ws = Worksheets("Tables")
    Set objTable = Ws.ListObjects("tblCompany")
    
    strWorksheets = "Source1,Source2,Source3,Source4"
    
    arrSheets = Split(strWorksheets, ",")
    
    For i = LBound(arrSheets) To UBound(arrSheets)
        With Worksheets(arrSheets(i))
            With .Range("A3:F" & .Range("A" & .Rows.Count).End(xlUp).Row)
                Set rng = fncResizeTable(objTable, .Rows.Count)
                rng.Value = .Value
            End With
        End With
    Next i
    
    ActiveWorkbook.Save
        
End Sub

Public Function fncResizeTable(objTable As Object, intAddRows As Integer) As Range
Dim lngRows As Long
Dim lngColumns As Long
Dim lngStartRow As Long
Dim lngStartColumn As Long

    With objTable
        lngRows = .DataBodyRange.Rows.Count
        lngColumns = .DataBodyRange.Columns.Count - 1
        lngStartRow = .Range.Cells(1).Row
        lngStartColumn = .Range.Cells(1).Column
        .Resize Range(Cells(lngStartRow, lngStartColumn), Cells(lngStartRow + lngRows + intAddRows, lngStartColumn + lngColumns).Address)
    End With
    
    Set fncResizeTable = Worksheets(objTable.Parent.Name).Cells(lngStartRow, lngStartColumn).Offset(lngRows + 1, 0).Resize(intAddRows, lngColumns + 1)

End Function