Union multiple excel sheets. (Paste underneath each other)

Question

What would be the cleverst way of copy and pasting Excel-Tables from multiple files to one single file. So espacially how do I determine the Range of the used Rows for the copy and paste within the makro?

The most simple way would be to loop through worksheets and find the last row ( http://stackoverflow.com/questions/11169445/error-finding-last-used-cell-in-vba ) and last column ( http://stackoverflow.com/questions/11883256/copy-last-column-with-data-on-specified-row-to-the-next-blank-column ) to identify the range and simply copy it over. — Siddharth Rout, Sep 04 '12 at 10:51

lori_m · Answer 1 · 2012-09-04T16:38:58.960

If this is a one time operation, probably the quickest way would be to activate the office clipboard (arrow in bottom right corner on Home tab). This allows up to 24 separate ranges to be collected and pasted below one another.

Assuming data is in one workbook and starts in row 2 on each sheet, as in the example below, you can:

Select all the tabs
Select all the rows on the first sheet
Press Ctrl+C, Ctrl+Page Down, repeatedly to copy all the data
Select a new sheet and click Paste All

Note that only the used range is copied so you can copy whole sheet ranges instead of needing to locate the last cell on each sheet.

enter image description here

score 1 · Accepted Answer · answered Sep 04 '12 at 11:35

If you really mean Tables you can reference them using the ListObjects collection.

Try this (code located in destination workbook)
This code copies all source tables as separate tables with a blank row between. If you want to merge the data into a single table you will need to copy lo.DataBodyRange rather than lo.Range and handle the header row and conversion to a table separetly.

Sub CopyTables()
    Dim wbFrom As Workbook
    Dim shFrom As Worksheet
    Dim shTo As Worksheet
    Dim lo As ListObject
    Dim clTo As Range

    ' Setup Destination for copied tables
    Set shTo = ThisWorkbook.Worksheets("DestinationSheet")  ' <-- change name to your destination sheet name
    ' remove any existing data
    shTo.UsedRange.EntireRow.Delete
    Set clTo = shTo.Cells(1, 1)
    ' Loop through open workbooks
    For Each wbFrom In Application.Workbooks
        ' except destination wb
        If wbFrom.Name <> ThisWorkbook.Name Then
            ' loop through all sheets
            For Each shFrom In wbFrom.Worksheets
                ' loop through all tables on sheet
                For Each lo In shFrom.ListObjects
                    lo.Range.Copy clTo
                    ' offset to next paste location, leave one empty row between tables
                    Set clTo = clTo.Offset(lo.ListRows.Count + 2, 0)
                Next
            Next
        End If
    Next
End Sub

Alternative inner For loop to paste to a single range

                For Each lo In shFrom.ListObjects
                    lo.DataBodyRange.Copy clTo
                    Set clTo = clTo.Offset(lo.ListRows.Count, 0)
                Next

Union multiple excel sheets. (Paste underneath each other)

2 Answers2