0

我有这个代码(工作)。

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 将永远不会......因为将会有一个不断增长的列表。

4

1 回答 1

1

您可以使用该代码,但将其包装在 with 函数中,如下所示

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
于 2013-02-11T00:53:12.813 回答