Macro to copy row based on TWO cell values

[uncleslinky]

Hi,

Is it possible to have a macro to copy an entire row to the bottom of another worksheet based on column G being "N" and column H being "YES". I would like to copy the data from a sheet and called "Hours" and paste it into a sheet called "DONE"

If there is no data I would like the macro to either end or have a pop up state that "all rows have been copied"

I have tried using auto filter however when copying data the header is always included, which I do not want.

Thanks

 

[VoG]

Try this

Sub CopyRows()
Dim LR As Long, i As Long, j As Long
With Sheets("Hours")
    LR = .Range("G" & Rows.Count).End(xlUp).Row
    For i = 2 To LR
        If .Range("G" & i).Value = "N" And .Range("H" & i).Value = "YES" Then
            j = j + 1
            .Rows(i).Copy Destination:=Sheets("DONE").Range("A" & Rows.Count).End(xlUp).Offset(1)
        End If
    Next i
End With
MsgBox "Done:" & vbNewLine & j & " rows copied", vbInformation
End Sub

 

[uncleslinky]

hi,

that's great, thanks!
is there a way to ammend this code so that instead of copying the entire row it only copies columns A:F?

thanks again!

 

[VoG]

Try

Sub CopyRows()
Dim LR As Long, i As Long, j As Long
With Sheets("Hours")
    LR = .Range("G" & Rows.Count).End(xlUp).Row
    For i = 2 To LR
        If .Range("G" & i).Value = "N" And .Range("H" & i).Value = "YES" Then
            j = j + 1
            .Range("A" & i).Resize(, 6).Copy Destination:=Sheets("DONE").Range("A" & Rows.Count).End(xlUp).Offset(1)
        End If
    Next i
End With
MsgBox "Done:" & vbNewLine & j & " rows copied", vbInformation
End Sub