将数据表与可变列组合时，Excel VBA 在每行插入工作表名称

Question

我的代码可以很好地将工作簿中多张工作表中的数据复制到摘要表中，并且可变数量的工作表始终包含完全相同格式的数据。

输入文件现在有可变数量的列（大约 50% 完全相同，50% 可变），我现在需要扩展代码，以便将工作表名称添加到复制到摘要表的数据中。然后我可以将固定格式的数据复制到汇总表上，并使用其中的一部分以及表名称来引用可变数据并将其复制到必要的列中。

当前代码如下，如果有人可以协助添加列和工作表名称，我将不胜感激。一旦我有了工作表名称，复制变量数据就很简单了。

 Sub CopyData()

Application.ScreenUpdating = False

Dim wsSummary As Worksheet
Dim LastRow As Long
Dim LastRow2 As Long

Set wsSummary = Worksheets("Summary")

LastRow = wsSummary.Cells(Rows.Count, "A").End(xlUp).Row

wsSummary.Range("A2:R" & LastRow).Clear

ShtCount = ActiveWorkbook.Sheets.Count

For i = 2 To ShtCount

Worksheets(i).Activate
LastRow2 = activesheet.Cells(Rows.Count, "A").End(xlUp).Row

Range("A2:R" & LastRow2).Select

Selection.Copy
Sheets("Summary").Activate

LastRow2 = activesheet.Cells(Rows.Count, "A").End(xlUp).Select

Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop

ActiveCell.Offset(0, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Application.CutCopyMode = False

Next i

End Sub

谢谢

Answer 1

我已经对代码进行了一些重构，让它变得更好 - 以下是它的工作原理：

Sub CopyData()
    Application.ScreenUpdating = False
    Dim wsSummary As Worksheet
    Dim LastRowWs As Long
    Dim LastRowSummary As Long
    Dim StartRowSummary As Long
    Set wsSummary = ThisWorkbook.Worksheets("Summary")
    LastRowSummary = wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Row + 1
    wsSummary.Range("A2:R" & LastRowSummary).Clear
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Summary" Then
            LastRowWs = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            StartRowSummary = wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Row + 1 'first empty row
            ws.Range("A2:R" & LastRowWs).Copy Destination:=wsSummary.Range("A" & StartRowSummary) 
            LastRowSummary = wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Row
            wsSummary.Range("S" & StartRowSummary & ":S" & LastRowSummary) = ws.Name
        End If
    Next
    Application.ScreenUpdating = True
End Sub

正如您所看到的，它最初非常相似，但我已经删除了所有.Select、.Activate 等命令，因为它们不是必需的，并且会在执行过程中减慢脚本的速度。我还完全限定了所有工作表引用，以确保我们始终知道我们所指的是工作簿的哪一部分。

LastRowSummary 最初设置为最后一行加 1。这只是为了确保如果摘要表中只有标题，则不会删除它们。

For Each 循环允许我们对工作簿中的每个工作表 ws 进行迭代。

我们不想从“摘要”中提取数据，所以不要执行该表的命令。

从我们所在的任何工作表中找到 A 列中的最后一行，并检测它将从摘要表上的哪个位置开始（当我们稍后要设置工作表名称时很重要）。

将范围从一个工作表复制到另一个工作表。现在获取摘要表的更新后的最后一行，因为这告诉我们需要为复制的工作表名称标记多少行。

由于我们在ws 中方便地引用了工作表，因此我们只需将列S 设置为ws.Name，使用我们之前检测到的开始行和结束行来确保在所有行上设置名称（我使用了 S 列，因为您似乎只是将 A 复制到 R；S 只是下一列；根据需要调整工作表名称的位置）。

最后，记得重新打开Application.ScreenUpdating。虽然由于此版本不使用 .Select 或 .Activate，但您不会在工作表之间滑动，因此您可以删除此属性的 False 和 True 设置而不会产生任何负面结果。

如果您需要任何进一步的解释，请告诉我？