Vba 将包含行的区域复制到另一张图纸

我的要求是将sheet3中字体颜色为黑色的行复制到sheet1。我在工作簿中有一系列从sheet3中选择的行。我想复制并粘贴到sheet1中。选择部分可以，但复制语句中出现错误（应用程序定义或对象定义）

Sub Copy()
Dim lastRow, i As Long    
Dim CopyRange As Range

lastRow = Sheet3.Rows.Count

With Sheets(Sheet3.Name)

    lastRow = .Range("A" & .Rows.Count).End(xlUp).Row

    For i = 1 To lastRow
         If .Rows(i).Font.Color = 0 Then
            If CopyRange Is Nothing Then
                Set CopyRange = .Rows(i)
            Else
                Set CopyRange = Union(CopyRange, .Rows(i))
            End If
        End If
    Next
End With
CopyRnge.Copy Destination:=Worksheets("Sheet1").Range("A1:J300")    
End Sub

---

Option Explicit

强制您声明所有使用的变量

运行程序时，

CopyRnge.Copy

不存在，因此Excel显示运行时错误

默认情况下，通过启用

选项Explicit

，可以避免此类常见错误

如何为VBA中的所有模块启用显式选项：

建议尝试的代码：

下面的代码使用了

选项Explicit

，它还利用了使用对象引用的优势

通过设置对象引用，您可以依靠Intellisense来确保避免输入错误

Option Explicit

Sub CopyBlackText()

    Dim lastRow As Long
    Dim i As Long

    Dim srcRangeToCopy As Range
    Dim destinationRange As Range

    Dim wrkbook As Workbook

    'Setup Object references by assigning and using the 'Set' keyword
    Set wrkbook = ActiveWorkbook

    Set destinationRange = wrkbook.Worksheets("Sheet1").Range("A1:J300")


    With wrkbook.Worksheets("Sheet3")

        'Using Cells(1,1).Address instead of saying Range("A1")
        lastRow = .Range(Cells(1, 1).Address).End(xlDown).Row

        For i = 1 To lastRow

             If .Rows(i).Font.Color = 0 Then

                If srcRangeToCopy Is Nothing Then
                    Set srcRangeToCopy = .Rows(i)
                Else
                    Set srcRangeToCopy = Union(srcRangeToCopy, .Rows(i))
                End If

            End If

        Next

    End With

    srcRangeToCopy.Copy Destination:=destinationRange

End Sub

---

使用

选项Explicit

，您会立即发现错误谢谢，使用CopyRnge而不是CopyRange。