Copy/Paste based on Criteria
I picked two areas on the same sheet, but you could easily change
them.
Sub macro1()
Dim ws As Worksheet
Dim iA As Integer
Dim iB As Integer
Dim c As Range
Dim rng As Range
Set ws = Worksheets("Sheet1")
Set rng = ws.Range("C2:C16")
For Each c In rng
If c = "A" Then
iA = iA + 1
ws.Cells(iA, 5) = c.Offset(0, -2)
ws.Cells(iA, 6) = c.Offset(0, -1)
Else
iB = iB + 1
ws.Cells(iB, 8) = c.Offset(0, -2)
ws.Cells(iB, 9) = c.Offset(0, -1)
End If
Next c
End Sub
Hth,
Merjet
|