[英]Excel VBA copying from one sheet to another without selection
我试图根据几个单元格的内容仅将所选范围从一张纸复制到另一张纸。 我开发的代码可以有效地复制和粘贴信息。 我已经审查了许多使用类似代码的网站,不同之处是我试图执行到一定范围。
我收到以下错误:运行时错误'1004':应用-定义或对象定义的错误
我的代码如下:
Option Explicit
Sub CopyRed()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim LastRow1 As Integer
Dim LastRow2 As Integer
Dim check As Integer
Dim Cond1 As String
Dim Cond2 As String
Dim Cond3 As String
Dim i as Integer
Set ws1 = Sheets(1)
Set ws2 = Sheets(2)
'set search criteria
'define # rows in tool tracker
Cond1 = ws1.Cells(1, 4)
Cond2 = ws1.Cells(2, 4)
Cond3 = ws1.Cells(3, 4)
LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
'Define # rows in current red and clear
LastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Range(ws2.Cells(2, 1), ws2.Cells(LastRow2, 70)).Clear
If Cond1 = "ALL" Then
For i = 6 To LastRow1
If ws1.Cells(i, 2) = "R" Then
LastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row.Offset(1, 0)
ws1.Range(Cells(i, 1), Cells(i, 70)).Copy ws2.Range(Cells(LastRow2, 1)) 'Error occurs here
End If
Next i
Else
For i = 6 To LastRow1
If ws1.Cells(i, 2) = "R" Then
If ws1.Cells(i, 4) = Cond1 Or ws1.Cells(i, 4) = Cond2 Or ws1.Cells(i, 4) = Cond3 Then
LastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws1.Range(Cells(i, 1), Cells(i, 70)).Copy Destination:=ws2.Range(Cells(LastRow2, 1), Cells(LastRow2, 70)) 'Error occurs here
End If
End If
Next i
End If
End Sub
如果我更改代码以仅选择范围,并逐步执行它,则会在两张纸上选择正确的范围。 我敢肯定这很简单,但是我不知如何解决。 任何帮助都会很棒。
在一些地方,您尚未完全使用工作表对所有单元格引用进行限定。 如果您的活动工作表与部分行中指定的工作表不同,则将导致错误。 我还将您的Integer声明更改为Long,这更有效并且可以满足更大的数据块。
Sub CopyRed()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim check As Long
Dim Cond1 As String
Dim Cond2 As String
Dim Cond3 As String
Dim i As Long
Set ws1 = Sheets(1)
Set ws2 = Sheets(2)
'set search criteria
'define # rows in tool tracker
Cond1 = ws1.Cells(1, 4)
Cond2 = ws1.Cells(2, 4)
Cond3 = ws1.Cells(3, 4)
LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
'Define # rows in current red and clear
LastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Range(ws2.Cells(2, 1), ws2.Cells(LastRow2, 70)).Clear
If Cond1 = "ALL" Then
For i = 6 To LastRow1
If ws1.Cells(i, 2) = "R" Then
LastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row.Offset(1, 0)
ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, 70)).Copy ws2.Cells(LastRow2, 1) 'Error occurs here
End If
Next i
Else
For i = 6 To LastRow1
If ws1.Cells(i, 2) = "R" Then
If ws1.Cells(i, 4) = Cond1 Or ws1.Cells(i, 4) = Cond2 Or ws1.Cells(i, 4) = Cond3 Then
LastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, 70)).Copy Destination:=ws2.Range(ws2.Cells(LastRow2, 1), ws2.Cells(LastRow2, 70)) 'Error occurs here
End If
End If
Next i
End If
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.