vba - 联合多个 Excel 工作表。（粘贴在彼此下方）

Question

将 Excel 表格从多个文件复制并粘贴到一个文件中的最聪明的方法是什么？因此，特别是如何确定在 makro 中复制和粘贴的已用行的范围？

Answer 1

如果这是一次性操作，可能最快的方法是激活办公室剪贴板（主页选项卡右下角的箭头）。这允许收集多达 24 个单独的范围并将其粘贴到另一个范围之下。

假设数据在一个工作簿中并从每张工作表的第 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