需要从几张不同的纸张垂直复制并粘贴到一张纸张中

Question

我正在尝试编写一个宏，该宏将从工作表中复制一系列单元格，将它们粘贴到包含所有粘贴数据的工作表（“批量工作表”）中，然后在第一张工作表之后移动到下一个选项卡.这需要为 40 多个选项卡完成。幸运的是，数据位于每个选项卡中的相同位置，包括 Bulksheet 选项卡。

我可以轻松地将它应用到一个选项卡，但是返回到第一个活动选项卡然后继续下一个选项卡会给我带来无穷无尽的麻烦。

例如。代码（缩短为关键位）。在 Next 的底部，我需要移动到下一张表并执行相同的功能，返回到“Bulksheet”并粘贴到 C 列中的下一个空单元格中：

Sub
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Activate
Range("C100:F103").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Bulksheet").Select
Range("D1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Next
End Sub

Answer 1

尝试使用索引值循环遍历工作表。

Sub
Dim i as integer
For i = 1 to worksheets.count
sheets(i).Activate
if activesheet.name <> "Bulksheet" then
Range("C100:F103").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Bulksheet").Select
Range("D1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
end if
Next
End Sub

Answer 2

试试这个：

Sub CopyToBulksheet()
Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Bulksheet" Then
        ws.Activate
        Range("C1:F10").Copy

        Sheets("Bulksheet").Select
        Range("D" & Cells.Rows.Count).End(xlUp).Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
Next
End Sub