Question

我有这个代码（工作）。

Sub Copy_Ten()
 Dim X As Long, LastRow As Long
 Dim CopyRange As Range
 LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
 For X = 1 To LastRow Step 4
     If CopyRange Is Nothing Then
         Set CopyRange = Rows(X).EntireRow
     Else
         Set CopyRange = Union(CopyRange, Rows(X).EntireRow)
     End If
 Next
 If Not CopyRange Is Nothing Then
 CopyRange.Copy Destination:=Sheets("Sheet2").Range("A1")
 End If
 End Sub

在表2中，它始终从A1开始。我希望它能够寻找下一个空间并继续。

我的代码是Range("A1").End(xldown).Select但是我不知道在哪里放。

因此，在第一次从A1开始之后，最终第2页永远不会......因为会有越来越多的名单。

Answer 1

您可以使用该代码，但将其包含在类似

的函数中

With Sheets("Sheet2")
    lastRow2 = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

然后改变

CopyRange.Copy Destination:=Sheets("Sheet2").Range("A1")

要

CopyRange.Copy Destination:=Sheets("Sheet2").Range("A" & lastRow2)

为了使这一点更清楚，请尝试以下

Sub Copy_Ten()
    Dim X As Long, LastRow As Long, PasteRow As Long
    Dim CopyRange As Range
    LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
    With Sheets("Sheet2")
        PasteRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    For X = 1 To LastRow Step 4
        If CopyRange Is Nothing Then
            Set CopyRange = Rows(X).EntireRow
        Else
            Set CopyRange = Union(CopyRange, Rows(X).EntireRow)
        End If
    Next
    If Not CopyRange Is Nothing Then
        CopyRange.Copy Destination:=Sheets("Sheet2").Range("A" & PasteRow)
    End If
End Sub

复制和;将第n行粘贴到另一张（mod）

1 个答案: