Combine Multiple Excel Tables

[Kalim Shaikh]

I have multiple Tables/sheets with Total Row in a workbook۔ I want to combine tables from sheets 1 to 10 (which may grow) without Total Row into an excel table. The resulting combine table should include a total amount row in Combine Sheet. I have below VBA code to an another workbook but it is not giving the desired results.

Sub Merge(ws() As Worksheet, destWs As Worksheet, headerInFirstRow As Boolean, removeDuplicates As Boolean)
    'Clear destination worksheet
    destWs.UsedRange.EntireRow.Delete
    Dim pasteRange As Range, header As Range, firstFreeRow As Range, w As Variant, copyRange As Range
    'Paste header
    If headerInFirstRow Then
        Set header = ws(0).UsedRange.Cells(1).EntireRow:
        header.Copy destWs.Cells(1).EntireRow
    End If
    Set firstFreeRow = destWs.UsedRange.Rows(destWs.UsedRange.Rows.Count).Offset(1).EntireRow
    'Paste worksheets
    For Each w In ws
        Set copyRange = w.UsedRange.Rows("" & _
            IIf(headerInFirstRow, 2, 1) & ":" & w.UsedRange.Rows.Count)
        copyRange.Copy firstFreeRow.Cells(1, 1)
        Set copyRange = Nothing
        Set firstFreeRow = destWs.UsedRange.Rows(destWs.UsedRange.Rows.Count).Offset(1).EntireRow
    Next w
    'Remove duplicates
    If removeDuplicates Then
        Dim colArr As Variant, col As Long: ReDim colArr(0 To destWs.UsedRange.Columns.Count - 1)
        For col = 1 To destWs.UsedRange.Columns.Count
            colArr(col - 1) = col
        Next col
        destWs.UsedRange.removeDuplicates Columns:=(colArr), header:=IIf(headerInFirstRow, xlYes, xlNo)
    End If
    'Clean
    Set firstFreeRow = Nothing: Set w = Nothing: Set header = Nothing
End Sub
Sub test()
With ActiveSheet
    .AutoFilterMode = False
    With Range("d1", Range("d" & Rows.Count).End(xlUp))
        .AutoFilter 1, "*Total Amount*"
        On Error Resume Next
        .Offset(1).SpecialCells(12).EntireRow.Delete
        End With
        .AutoFilterMode = False
End With
End Sub
Sub Combine()
Dim ws(0 To 22) As Worksheet
    Set ws(0) = Sheet1
    Set ws(1) = Sheet2
    Set ws(2) = Sheet3
    Set ws(3) = Sheet4
    Set ws(4) = Sheet5
    Set ws(5) = Sheet6
    Set ws(6) = Sheet7
    Set ws(7) = Sheet8
    Set ws(8) = Sheet9
    Set ws(9) = Sheet10
    Set ws(10) = Sheet11
    Set ws(11) = Sheet12
    Set ws(12) = Sheet13
    Set ws(13) = Sheet14
    Set ws(14) = Sheet15
    Set ws(15) = Sheet16
    Set ws(16) = Sheet17
    Set ws(17) = Sheet18
    Set ws(18) = Sheet19
    Set ws(19) = Sheet20
    Set ws(20) = Sheet21
    Set ws(21) = Sheet22
    Set ws(22) = Sheet22
    Merge ws, Sheet23, True, False
End Sub

 

[GlennUK]

What do you mean : "it is not giving the desired results" ? You need to give some clues as to what you see going wrong.

 

[alansidman]

You may want to explore using Power Query to combine your tables

 

[Kalim Shaikh]

What do you mean : "it is not giving the desired results" ? You need to give some clues as to what you see going wrong.

Thank you sir for your interest actually I needed a separate code to recheck the account. The problem is solved and I got the code from the same forum۔

 

[Kalim Shaikh]

You may want to explore using Power Query to combine your tables

Thanks sir I will definitely work on it.