copy rows

M

MAx

I am trying to avoid using select. Does anyone have any better code to achieve the following result

Sub loopcopy(
Dim target As Strin
target = "Asset
For a = 1 To 200
If Sheets(1).Cells(a, 1) = target Then GoSub hi
Next
Exit Su

hit
x = Application.CountA(Sheets(2).Columns("a")
Rows(a).Cop
Sheets(2).Selec
Rows(x).Selec
ActiveSheet.Past
Sheets(1).Selec
Retur

End Su

TIA
 
L

Lawlera

Sub loopcopy(
Dim target As Varian
target = "Asset
For a = 1 To Application.CountA(Sheets(1).Columns("a")
If Sheets(1).Cells(a, 1) = target Then GoSub hi
Next
Exit Su

hit
x = Application.CountA(Sheets(2).Columns("a")
Sheets(1).Rows(a).Copy Destination:=Sheets(2).Cells(x + 1, 1
Retur

End Su

HTH
 
Top