使用工作表名称循环将范围从一张工作表复制到另一张工作表

Question

我正在尝试将 118 张表格编译成两个表格（每个表格 59 个表格）。我有一个工作表“工作表列表”中所有工作表名称的列表。目前我的代码只返回最后一张表中的表格，大概会覆盖所有其他表格。对于第一组 59 张纸，每张纸上的范围都是相同的 ("A5:F73")。对于接下来的 59 张纸，行数在 69 到 68 行之间变化，所以我想最简单的处理方法是编写代码，从单元格 A5 开始选择（总是），选择所有列到 F 列，然后进行行计数以确定要复制的最后一行。

以下是迄今为止我为一组已知范围的工作表拼凑而成的内容：

Sub ConsolData()

Dim sheet_name As Range
Dim lastrowdata As Long

With Sheets("SB Summary")
    lastrowdata = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
End With

For Each sheet_name In Sheets("Sheet Listing").Range("D6:D64") 
If sheet_name.value = "" Then 
    exit For 

Else
    Sheets(sheet_name.value).select 
    Range("A5:F73").Select 
Selection.Copy

Sheets("SB Summary").select
Range("B2").Offset(lastrowdata).Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False
Sheets(sheet_name.value).select
End If
Next sheet_name

End Sub

我认为问题在于指定要粘贴到的最后一行数据的代码行：

Range("B2").Offset(lastrowdata).Select

问题 1：如何正确指定偏移量以防止覆盖之前粘贴的表格？

问题 2：修改此代码是否更容易同时处理第二组 59 个表的动态范围，以便它适用于第一组 59 个静态/已知范围？

问题 3：对于复制的每个范围，我想将工作表名称填写到刚刚粘贴的内容旁边的 H 列中的所有单元格中，以便我知道它来自哪里。我该怎么做？

Answer 1

您的分析是正确的，您的代码用最新的数据覆盖了以前复制的数据。
所以最后你只会得到最后的数据。
我已经重写了你的代码来解决这个问题，也涵盖了动态数据源。

Sub ConsolData()
    Dim sheet_name As Range
    Dim lastrowdata As Long
    '~~> Added this so it looks clean
    Dim ws As Worksheet: Set ws = Sheets("SB Summary")

    With Application
        .ScreenUpdating = False
    End With

    For Each sheet_name In Sheets("Sheet Listing").Range("D6:D64")
        If sheet_name.Value = "" Then
            Exit For
        Else
            '~~> Work on your sheet object directly
            With Sheets(sheet_name.Value)
                '~~> Find the last row of data from target sheet
                '~~> I used this method since you mention Table
                lastrowdata = .Range("A:A").Find("*", [A1], , , , xlPrevious).Row
                .Range("A5:F" & lastrowdata).Copy
                '~~> Find the lastrow in destination sheet
                ws.Range("B:B").Find("*", [B1], , , , xlPrevious) _
                    .Offset(1, 0).PasteSpecial xlPasteValues
            End With
        End If
    Next sheet_name

    With Application
        .ScreenUpdating = False
        .CutCopyMode = False
    End With
End Sub

上述代码使用范围对象查找方法在您每次处理工作表对象时查找最后一行。
在SB Summary中，我们使用Offset方法将值粘贴到数据的最后一行下方。
HTH。

顺便说一句，您可能有兴趣阅读以下链接以进一步改进您的编码。

How to avoid using Select in Excel VBA macros