我的要求是将具有字体颜色为黑色的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
答案 0 :(得分:0)
Option Explicit
强制您声明您使用的所有变量。
CopyRnge.Copy
不存在,因此Excel显示运行时错误。
默认情况下启用Option Explicit
可以避免这些常见错误。
如何为VBA中的所有模块启用Option Explicit:
建议使用的代码:
下面的代码使用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