Solved: Run Time 1004 error

[austenr]

Anyone know why I would get this error on this code? It abends at the first ActiveSheet.Paste if the If statement is true.

[VBA] Sub CopyRows()
Sheets("Sheet1").Select
' Find the last row of data
FinalRow = Range("A65536").End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column H
ThisValue = Range("E" & x).Value
If ThisValue = "MATCH" Then
Range("A" & x & ":C" & x).Copy
Sheets("Sheet2").Select
NextRow = Range("A65536").End(xlUp).Row + 1
Range("A" & NextRow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ElseIf ThisValue = "No Match" Then
Range("A" & x & ":C" & x).Copy
Sheets("Sheet3").Select
NextRow = Range("A65536").End(xlUp).Row + 1
Range("A" & NextRow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
End If
Next x
End Sub [/VBA]

[Zack Barresse]

I recommend using the PasteSpecial method when pasting using VBA, it's quite tempermental if you don't.

...

[vba]Sub CopyRows()
Dim FinalRow As Long, NextRow As Long
' Sheets("Sheet1").Select
' Find the last row of data
FinalRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column H
ThisValue = Sheets("Sheet1").Range("E" & x).Value
If ThisValue = "MATCH" Then
NextRow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("Sheet1").Range("A" & x & ":C" & x).Copy
Sheets("Sheet2").Range("A" & NextRow).PasteSpecial xlPasteAll
ElseIf ThisValue = "No Match" Then
NextRow = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("Sheet1").Range("A" & x & ":C" & x).Copy
Sheets("Sheet3").Range("A" & NextRow).PasteSpecial xlPasteAll
End If
Next x
End Sub[/vba]

That work for ya?

Btw, I think there is a way to do this without looping, but I don't really have much time right now to pick through what your code is doing exactly without seeing an example file. But off-hand, it appears this can be done in a few command lines rather than a loop.. I would think.

[mvidas]

You could also just enter the destination in the Destination argument position:[vba]Sub CopyRows()
Dim x As Long, ThisValue As String
With Sheets("Sheet1")
For x = 2 To .Range("A65536").End(xlUp).Row
ThisValue = .Range("E" & x).Value
If ThisValue = "MATCH" Then
.Range("A" & x & ":C" & x).Copy Sheets("Sheet2").Range("A65536"). _
End(xlUp).Offset(1, 0)
ElseIf ThisValue = "No Match" Then
.Range("A" & x & ":C" & x).Copy Sheets("Sheet3").Range("A65536"). _
End(xlUp).Offset(1, 0)
End If
Next x
End With
End Sub[/vba]Matt

[austenr]

Thanks Matt & Zack. Both work but I went with Matts since it is less code. Works as advertised.

[mvidas]

Austenr,

Though it isn't necessary, and it is more code, this should be a bit faster depending on the size of your data. Its the only way I could think of doing it without looping, and after seeing the newest excel mvp (HUGE CONGRATULATIONS ZACK!) suggest a non-looping method, I figured why not try it [vba]Sub CopyRows()
Dim nWS As Worksheet, FNDf As Range, FNDl As Range
Application.ScreenUpdating = False
Sheets("Sheet1").Copy Before:=Sheets("Sheet1")
Set nWS = Sheets(Sheets("Sheet1").Index - 1)
nWS.Cells.Sort nWS.Columns(5), xlAscending, nWS.Columns(1), Order2:= _
xlAscending, Header:=xlYes
Set FNDf = nWS.Columns(5).Find("MATCH", LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=xlTrue)
If Not FNDf Is Nothing Then
Set FNDl = nWS.Columns(5).Find("MATCH", SearchDirection:=xlPrevious)
Intersect(nWS.Range(FNDf, FNDl).EntireRow, nWS.Columns("A:C")).Copy _
Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Set FNDf = nWS.Columns(5).Find("No Match", SearchDirection:=xlNext)
If Not FNDf Is Nothing Then
Set FNDl = nWS.Columns(5).Find("No Match", SearchDirection:=xlPrevious)
Intersect(nWS.Range(FNDf, FNDl).EntireRow, nWS.Columns("A:C")).Copy _
Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Application.DisplayAlerts = False
nWS.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub[/vba]Matt

[austenr]

Thanks Matt.

[austenr]

Having sorting problems now. Same error in the code after x is processed for the last time.


[VBA] Sub CopyRows()
Application.ScreenUpdating = False
Dim FinalRow As Long, NextRow As Long
' Find the last row of data
FinalRow = Sheets("Sheet1").Cells(Rows.count, "A").End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column E
ThisValue = Sheets("Sheet1").Range("E" & x).Value
If ThisValue = "MATCH" Then
NextRow = Sheets("Sheet2").Cells(Rows.count, "A").End(xlUp).Row + 1
Sheets("Sheet1").Range("A" & x & ":C" & x).Copy
Sheets("Sheet2").Range("A" & NextRow).PasteSpecial xlPasteAll
ElseIf ThisValue = "No Match" Then
NextRow = Sheets("Sheet3").Cells(Rows.count, "A").End(xlUp).Row + 1
Sheets("Sheet1").Range("A" & x & ":C" & x).Copy
Sheets("Sheet3").Range("A" & NextRow).PasteSpecial xlPasteAll
End If
Next x

Sheets("Sheet2").Range("A2:C1698").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.ScreenUpdating = True
End Sub [/VBA]

[mvidas]

You can remove the .Select statement from there, and just use:[vba] Sheets("Sheet2").Range("A2:C1698").Sort Key1:=Sheets("Sheet2").Range("A2"), _
Order1:=xlAscending, Header:=xlNo[/vba]though I think you'd be a little better off not hardcoding the range, like:[vba] Sheets("Sheet2").Range("A:C").Sort Key1:=Sheets("Sheet2").Columns("A"), _
Order1:=xlAscending, Header:=xlYes[/vba]Matt

[mvidas]

I'm curious though, did the code at http://www.vbaexpress.com/forum/show...53&postcount=5 work for you? I just changed it to sort column A as well before copying, but you'd probably still need to sort after copying too. Just curious, worked on my test data but not sure how it would work for your real data.

[austenr]

Yep.. Everything worked great. Sort included. Thanks Matt. Out of curiosity, why was I getting that error on the sort?

[mvidas]

why was I getting that error on the sort?

You may have gotten errors on the .Select line too (if sheet2 wasn't the active sheet). The reason you got the error on the sort was probably because your Range("A2") didnt have a sheet qualifier. Honestly, unless you changed sheets in mid-run, I don't really know why you would have gotten that error, but its better to be safe anyways. Using Selection causes errors a lot if you're not careful, so its better to avoid that and make sure everything is qualified