VBA to match and copy data to another worksheet

[JKast]

Hello, reading responses posted on here has been a great help to me in the past and I was wondering if someone might have some insight into my problem.

I have a main worksheet with over 2000 lines of data. In column G there are letters A-F. I would like to pull all the A's, B's and D's into separate worksheets I've created.

Basically, I'm looking for an argument that says "If cell G2 is A, then copy and paste the whole row into worksheet A. If cell G2 is B, then copy and paste the whole row into worksheet B. I need this argument to scroll through all 2000 lines of data. Below is the code I have so far, it works for pulling all the A's out, but I'm not sure how to include an argument for pasting B's in the B worksheet and D's in the D worksheet.

Sub CopyData()
Dim i As Long
For i = 2 To 2000 'change numbers to the range of rows you are checking
If Range("g" & i) = "A" Then
Range("g" & i).EntireRow.Copy _
Destination:=Sheets("A").Range("A65536").End(xlUp).Offset(1, 0)

End If
Next
End Sub

I'd appreciate any help!

John

 

[pboltonchina]

You already the basis of it, you just need to repeat it, maybe like this. Try on a copy of your data.

Sub CopyData()
Application.ScreenUpdating = False
Dim i As Long
For i = 2 To 2000 'change numbers to the range of rows you are checking
If Range("g" & i) = "A" Then
Range("g" & i).EntireRow.Copy _
Destination:=Sheets("A").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next
For i = 2 To 2000 'change numbers to the range of rows you are checking
If Range("g" & i) = "B" Then
Range("g" & i).EntireRow.Copy _
Destination:=Sheets("B").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next
For i = 2 To 2000 'change numbers to the range of rows you are checking
If Range("g" & i) = "D" Then
Range("g" & i).EntireRow.Copy _
Destination:=Sheets("D").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next
Application.ScreenUpdating = True
End Sub

 

[JKast]

Great! Thank you