vba - 将包含行的范围复制到另一个工作表

Question

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

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

Answer 1

Option Explicit强制您声明您使用的所有变量。
CopyRnge.Copy运行程序时不存在，因此 Excel 显示运行时错误。



开启 Option Explicit 可以避免此类常见错误。默认。

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




建议尝试代码:

下面的代码使用 Option 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