Copy entire row from another worksheet

[Jazzer]

Hello,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
I am looking for some code which will enable me to copy the entire row from another worksheet based on specific criteria<o></o>
<o></o>
In worksheet REC I want to copy any row where a cell in column G contains the text WRONG<o></o>
Also I want to copy any row where column H contains a value greater or less than zero<o></o>
<o></o>
The rows need to be pasted into worksheet exceptions starting in row 7<o></o>
<o></o>
Many Thanks<o></o>
James<o></o>

 

[VoG]

Try

Sub CopyRows()
Dim LR1 As Long, LR2 As Long, i As Long
LR1 = WorksheetFunction.Max(7, Sheets("exceptions").Range("A" & Rows.Count).End(xlUp).Row + 1)
With Sheets("Rec")
    LR2 = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LR2
        If .Range("G" & i).Value Like "*WRONG*" Or .Range("H" & i).Value <> 0 Then
            .Rows(i).Copy Destination:=Sheets("Exceptions").Range("A" & LR1)
            LR1 = LR1 + 1
        End If
    Next i
End With
End Sub

 

[SydneyGeek]

A filter may be the way to go. It can be automated but, given that you can filter everything in one hit, a manual copy/paste may do. Autofilter can't do the job in one go but the Advanced Filter can.

1. Create 4 blank rows at the top of your worksheet (REC).
2. Copy the headings from Row 5 to Row 1.
3. In G2 enter WRONG; in H3 enter <>0
4. Place your cursor somewhere in the main body of the table (say, A5) and start the Advanced Filter. In 2003 and below, Data > Filter > Advanced Filter. In 2007 and higher, Data > Filter group > Advanced.
The filter should highlight the man table as the filter list.
5. Click the rangefinder next to Criteria, and drag over A1:H3. You can extend to the right to include any additional headings but DO NOT add blank rows.
6. Click OK and your data should be filtered. Now it's a simple copy/paste.

Denis

 

[Jazzer]

Try

Sub CopyRows()
Dim LR1 As Long, LR2 As Long, i As Long
LR1 = WorksheetFunction.Max(7, Sheets("exceptions").Range("A" & Rows.Count).End(xlUp).Row + 1)
With Sheets("Rec")
    LR2 = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LR2
        If .Range("G" & i).Value Like "*WRONG*" Or .Range("H" & i).Value <> 0 Then
            .Rows(i).Copy Destination:=Sheets("Exceptions").Range("A" & LR1)
            LR1 = LR1 + 1
        End If
    Next i
End With
End Sub

Thanks for that - I am having trouble getting it to work - at the moment nothing seems to happen when I run this macro - is there anything I should be aware of ?

"Cant execute code in break mode"

thanks

 

[VoG]

Click the Reset button .

If column A is empty try

Sub CopyRows()
Dim LR1 As Long, LR2 As Long, i As Long
LR1 = WorksheetFunction.Max(7, Sheets("exceptions").Range("A" & Rows.Count).End(xlUp).Row + 1)
With Sheets("Rec")
    LR2 = .Range("G" & Rows.Count).End(xlUp).Row
    For i = 1 To LR2
        If .Range("G" & i).Value Like "*WRONG*" Or .Range("H" & i).Value <> 0 Then
            .Rows(i).Copy Destination:=Sheets("Exceptions").Range("A" & LR1)
            LR1 = LR1 + 1
        End If
    Next i
End With
End Sub