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设置，而不会产生任何否定结果。< / p>

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

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

1 个答案: