Copy and paste row to another worksheet depending on cell value.

[Ippon]

How do I Copy and paste row to another worksheet depending on cell value. e.g.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
Where any cell in column D of a Worksheet named "Clients" contains the word "Employed" then copy that row of the worksheet from Column A to G into the first available blank row in another worksheet named "Employed".<o></o>

 

[daverunt]

Hi,
Try this code.

Sub Copy_Rows()
 
Set rng = Worksheets("Clients").Range(Worksheets("Clients").Range("D1"), Worksheets("Clients").Range("D" & Rows.Count).End(xlUp))
x = 1
    For Each Cell In rng
 
    If Cell.Value = "Employed" Then
    num = Cell.Row
 
    Worksheets("Clients").Range("A" & num & ":" & "G" & num).Copy Destination:=Worksheets("Employed").Range("A" & x)
    x = x + 1
 
    End If
 Next
End Sub

 

[Ippon]

Thanks Dave. Haven't got it working yet but will keep playing with it - I must be doing something wrong

 

[Ippon]

Almost working now - The only issue is that it copies over the existing column lables in the destination worksheet "Employed". ie Copies over A1 to D1. So I guess it's not finding the first blank row? Any ideas on this please.

 

[daverunt]

Hi,

just set x=2 and it will fill from the second row.

 

[Ippon]

Thank you - all perfect now.

 

[Ippon]

I spoke too soon - At the risk of being a pain in the neck - it fills from the second row regardless of if it is blank or already contains data - Can it find the first empty row?

 

[daverunt]

Hi,

The code would only do the search once and paste from row 2 down so if you re-run the macro it would overwrite from row 2 down. Instead it should be looking for the next empty cell as stated in your post!

That's not your fault. It's my poor reading.

Try this insted.

Sub Copy_Rows()
Worksheets("Clients").Select
    Set rng = Worksheets("Clients").Range(Worksheets("Clients").Range("D1"), Worksheets("Clients").Range("D" & Rows.Count).End(xlUp))
    For Each Cell In rng
    
    If Cell.Value = "Employed" Then
    num = Cell.Row
     
    Worksheets("Clients").Range("A" & num & ":" & "G" & num).Copy Destination:=Worksheets("Employed").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
   End If
 Next
End Sub

 

[Ippon]

Thank you very much Daverunt that's great. All working now.
I have learnt a lot about VBA (as a beginner) from your replies and playing with this.

 

[daverunt]

Great. Thanks for the feedback.