Copy and Paste to New Workbook

[rl_davis]

Can someone look at the new code and tell me why it does
not work. It copies all rows with the work Ard in the
worksheet called Ard but it seems to be pasting each row
copied to the same row in the destination. I thought that
a counter would help this. Do I have it in the wrong
place? I think I have tried everywhere. THANKS FOR THE
HELP.

Dim RNG As Range, rng1 As Range
Dim cell As Range

Counter = 0

With Worksheets(2)

On Error Resume Next
Set RNG = .Range(.Cells(2, "L"), _
Cells(Rows.Count, "L").End(xlUp))
Set rng1 = RNG.SpecialCells(xlConstants)
On Error GoTo 0

Counter = 0

If Not rng1 Is Nothing Then
For Each cell In RNG
Counter = 2
If .Cells(cell.Row, "L").Value Like "Ard" Then
Rows(cell.Row).Copy Sheets("Ard").Rows(Counter)
.Cells(cell.Row, "L").Value = "ARD"

End If
Counter = Counter + 2
Next
End If
End With

 

[Dave Peterson]

I think it's here:

Counter = 0

If Not rng1 Is Nothing Then
For Each cell In RNG
Counter = 2
If .Cells(cell.Row, "L").Value Like "Ard" Then
Rows(cell.Row).Copy Sheets("Ard").Rows(Counter)
.Cells(cell.Row, "L").Value = "ARD"
End If
Counter = Counter + 2
Next
End If

Everytime you change cells, the counter gets reset to 2.

Maybe:

Counter = 1
If Not rng1 Is Nothing Then
For Each cell In RNG
If .Cells(cell.Row, "L").Value Like "Ard" Then
Rows(cell.Row).Copy Sheets("Ard").Rows(Counter)
.Cells(cell.Row, "L").Value = "ARD"
counter = counter + 1 'or +2
End If
Next
End If