Скопировать строки из таблицы на листе в конец таблицы на отдельном листе

Question

Я искал несколько дней, чтобы не найти VBA для этого.Я хочу взять строки из таблиц на других листах и ​​вставить их в 1 таблицу на 1 листе внизу.

Пример: на листе 1 есть таблица «table1».На листе 2 есть таблица с данными «table2». На листе 3 есть таблица с данными «table3»

. Я хочу взять данные (всю таблицу без заголовков), скопировать и вставить их в «table1» на листе 1 вконец таблицы.Затем я скопирую и вставлю код для sheet3 и других.Я озадачен тем, чтобы заставить это работать для 1 листа, уже не говоря о многократном.Спасибо!

Answer 1

Я предполагаю, что все ваши листы с 1 по 3 находятся в одной книге.Если нет, измените ThisWorkbook, чтобы указать, в каких книгах находятся листы «2» и «3». Я также предполагаю, что все ваши таблицы имеют одинаковый размер.

Sub CopyTablesToTable1()
    ' Assign worksheets
    Dim sheet1 As Worksheet
    Dim sheet2 As Worksheet
    Dim sheet3 As Worksheet
    With ThisWorkbook
        Set sheet1 = .Worksheets("Sheet 1")
        Set sheet2 = .Worksheets("Sheet 2")
        Set sheet3 = .Worksheets("Sheet 3")
    End With

    'Get the table to copy to
    Dim targetTable As ListObject
    Set targetTable = sheet1.ListObjects("table1")

    If Not targetTable.DataBodyRange Is Nothing Then _
        targetTable.DataBodyRange.Delete '' clear out table 1 data and rows

    Dim srcData As ListObject
    Dim targetRange As Range


    ' Get the first Source Table Copied
    Set srcData = sheet2.ListObjects("table2")
    Call CopyTableData(targetTable, srcData)

    '' Copy the second source table copied
    Set srcData = sheet3.ListObjects("table3")
    Call CopyTableData(targetTable, srcData)


End Sub

Sub CopyTableData(targetTable As ListObject, srcData As ListObject)

    '' If the target table already has data
    If Not targetTable.DataBodyRange Is Nothing Then
        '' top left part of the range
        '' targetTable.DataBodyRange.End(xlDown).Offset(1, 0)

        '' Bottom Right part of the range
        '' targetTable.DataBodyRange.End(xlDown).Offset(srcData.DataBodyRange.Rows.Count, srcData.DataBodyRange.Columns.Count - 1)
        Set targetRange = Range(targetTable.DataBodyRange.End(xlDown).Offset(1, 0), _
                                targetTable.DataBodyRange.End(xlDown).Offset(srcData.DataBodyRange.Rows.Count, srcData.DataBodyRange.Columns.Count - 1))

    Else '' If the target table is empty

        '' top left part of target
        ''targetTable.HeaderRowRange.Cells(1,1).offset(1,0)

        '' Bottom right part of the target range
        '' targetTable.HeaderRowRange.Cells(1, 1).Offset(srcData.DataBodyRange.Rows.Count, srcData.DataBodyRange.Columns.Count - 1)

        Set targetRange = Range(targetTable.HeaderRowRange.Cells(1, 1).Offset(1, 0), _
                                targetTable.HeaderRowRange.Cells(1, 1).Offset(srcData.DataBodyRange.Rows.Count, srcData.DataBodyRange.Columns.Count - 1))

    End If

    ' Copy the data
    targetRange.Value = srcData.DataBodyRange.Value

End Sub