vba - 複数のExcelシートを結合します。（下に貼り付けます）

Question

複数のファイルから1つのファイルにExcelテーブルをコピーして貼り付ける最も賢い方法は何でしょうか。それでは、特に、マクロ内でコピーアンドペーストするために使用される行の範囲をどのように決定するのですか？

Answer 1

これが1回限りの操作である場合、おそらく最も簡単な方法は、オフィスクリップボードをアクティブにすることです（[ホーム]タブの右下隅にある矢印）。これにより、最大24の個別の範囲を収集して、互いに下に貼り付けることができます。

次の例のように、データが1つのブックにあり、各シートの2行目から始まると仮定すると、次のことができます。

• すべてのタブを選択します
• 最初のシートのすべての行を選択します
• Ctrl + C、Ctrl + Page Downを繰り返し押して、すべてのデータをコピーします
• 新しいシートを選択し、[すべて貼り付け]をクリックします

各シートの最後のセルを見つける必要がなく、シート範囲全体をコピーできるように、使用された範囲のみがコピーされることに注意してください。

Answer 2

本当にテーブルを意味する場合は、ListObjectsコレクションを使用してそれらを参照できます。

これを試してください（宛先ワークブックにあるコード）
このコードは、すべてのソーステーブルを、間に空白行を含む個別のテーブルとしてコピーします。データを単一のテーブルにマージする場合は、ヘッダー行とテーブルへの変換を個別に処理するのlo.DataBodyRangeではなく、コピーする必要があります。lo.Range

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

単一の範囲に貼り付ける代替の内部Forループ

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