Excel VBA 每个循环复制和粘贴信息

Question

我正在编写的代码本质上是通过工作簿浏览每张工作表，然后复制其中的所有内容以粘贴到工作簿的最终工作表中。我目前只是将所有内容粘贴到 Sheet3 中作为测试，但问题是，当我将宏运行到 Sheet3 中时，它只会复制我打开的任何工作表的内容。它会将相同的内容从单个工作表粘贴到 Sheet3 中，次数与我有工作表的次数相同，而不是复制每个工作表的内容。我当前的代码是这样的：

Sub Copy_Paste()
'
' Copy_Paste Macro
'
' Keyboard Shortcut: Ctrl+w
'
   Dim Current As Worksheet
         ' Loop through all of the worksheets in the active workbook.
         For Each Current In ThisWorkbook.Worksheets
            Range("A2", Range("k1048576").End(xlUp)).Select
            Selection.Copy
            Sheets("Sheet3").Select
            Range("A1048576").End(xlUp).Offset(1).Select
            ActiveSheet.Paste
            MsgBox Current.Name
         Next Current
End Sub

我每次都尝试将其返回到 Current，例如将循环中的第一行设为 Current.Range("A2", Range("k1048576").End(xlUp)).Select 或将第一行设为 Sheets(Current) .Select 但每个只会在我尝试运行代码时给出错误。

Answer 1

这就是您的代码的样子，同时避免

Select

Sub Copy_Paste()
'
' Copy_Paste Macro
'
' Keyboard Shortcut: Ctrl+w
'
    Dim Current As Worksheet, lRow As Long, lRow3 As Long
    lRow3 = Sheets("Sheet3").Range("K" & Sheets("Sheet3").Rows.Count).End(xlUp).Row + 1
    ' Loop through all of the worksheets in the active workbook.
    For Each Current In ThisWorkbook.Worksheets
        If Current.Name <> "Sheet3" Then
            With Current
                lRow = .Range("K" & .Rows.Count).End(xlUp).Row
                .Range("A2:K" & lRow).Copy
                Sheets("Sheet3").Range("A" & lRow3).Paste
                Debug.Print "Current Sheet was: " & .Name
                lRow3 = lRow3 + lRow 'this already offsets by 1 due to starting at A2
            End With
        End If
    Next Current
End Sub

注意，我使用

With... End With

来避免一遍又一遍地重新输入

Current

（在空格后面有点的地方）。