从多个 sheet 复制并粘贴到 sheet 1

Question

我正在尝试从多个作品sheet中获取数据并粘贴到sheet 1 中，但我的代码无法正常工作。它一遍又一遍地从 sheet "table 1" 复制。有谁知道我的代码有什么问题吗？

谢谢

Option Explicit

Sub test()

Dim ws As Worksheet
Dim i As Integer

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Table 1" Then

            ActiveSheet.Range("A15:X35").Select
            Selection.Copy

            Worksheets("Table 1").Activate

                For i = 1 To 5000

                    If IsEmpty(Cells(i, 1)) = True And IsEmpty(Cells(i + 1, 1)) = True Then
                    ActiveSheet.Cells(i, 1).Select
                    ActiveSheet.Paste
                    Exit For
                    End If

                Next i

        End If
    Next ws

End Sub

Answer 1

在您的循环中，您正在从 ActiveSheet 复制，而不是从 ws 复制。如果 activeSheet 是 "table 1"（实际上，您在语句 Worksheets("Table 1").Activate 中自己激活了 table 1），那么当然会继续从中复制。

此外，最好直接从范围复制而不使用 Activate 和 Select。我想这就是你想要做的：

With Worksheets("Table 1")
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Table 1" Then
            For i = 1 To 5000
                If IsEmpty(.Cells(i, 1)) And IsEmpty(.Cells(i + 1, 1)) Then
                    ws.Range("A15:X35").Copy .Cells(i, 1)
                    Exit For
                End If
            Next i
        End If
    Next ws
End With

从多个 sheet 复制并粘贴到 sheet 1

Copy from multiple sheets and paste into sheet 1

vba

loops

copy

copy-paste

worksheet