Question

我有一本包含大约300个工作表的工作簿。我正在尝试遍历每个工作表，复制特定范围，并将其粘贴到摘要表中。我需要将每个连续的粘贴放在最后一个使用行下面的一行。我是循环的新手，但我认为复制的信息量过多（导致错误），我已经明白.value方法的内存密集程度要低得多。

如何合并.value方法来实现此目的？这是我试图编写的代码（再次，我是编码新手，对不起）。

Sub Consolidation()

Dim ws As Worksheet

Sheets("Summary").Select

For Each ws InThisWorkbook.Sheets

ActiveSheet.Range("A" & Rows.Count).End(xLUp).Offset(1).Value ="ws.Range("BB1").End(xLToRight).End(xLDown).Select"

Next ws

End Sub

或者，有更好的方法吗？意思是，.value方法是解决这个问题的方法吗？

Answer 1

这个问题类似于：

Simple Copy/Paste Loop not working on each worksheet

这是您使用.Value

的方式

Sub WsLoop()

    Dim ws As Worksheet
    Dim Summary As Worksheet

    Set Summary = ThisWorkbook.Sheets("Summary")

    For Each ws In ThisWorkbook.Sheets
        If Not ws.Name = "Summary" Then 'This will skip Summary.
            Summary.Range("A1").Value = ws.Range("A1").Value
        End If
    Next ws

End Sub

Answer 2

Sub loop_through_all_worksheets_cpyPst()

Dim ws As Worksheet
Dim starting_ws As Worksheet
Set starting_ws = Sheets("startAtSheet")

'remember which worksheet is active in the beginning


For Each ws In ThisWorkbook.Worksheets
    ws.Activate

If Not ws.Name = "SheettoPasteTo_skipCopy" Then 'This will skip Summary.
           
    Range("A2:I2").Select
'my section range had only columns till i - edit the to last column 

    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("SheettoPasteTo_skipcopy").Select
'edit this sheet name to copy to 

    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.End(xlDown).Select
   
End If
       
    ws.Cells(1, 1) = 1 'this sets cell A1 of each sheet to "1"
   
Next

starting_ws.Activate 
'activate the worksheet that was originally active

End Sub

复制/粘贴循环通过工作表进行整合

2 个答案: