将带有行的范围复制到另一个工作表

时间:2014-03-11 09:23:05

标签: excel vba excel-vba

我的要求是将具有字体颜色为黑色的sheet3中的行复制到sheet1.I具有从工作簿中的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

1 个答案:

答案 0 :(得分:0)

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

运行程序时

CopyRnge.Copy不存在,因此Excel显示运行时错误。

Run-time error 1004

默认情况下启用Option Explicit可以避免这些常见错误。


如何为VBA中的所有模块启用Option Explicit:

Step 1 Step 2


建议使用的代码:

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