Simple seach and copy help needed
Sub Macro1()
Dim iCt As Integer
Dim iRow1 As Integer
Dim iRow2 As Integer
iRow1 = Sheets(1).Range("A65536").End(xlUp).Row
For iCt = 1 To iRow1
If Sheets(1).Cells(iCt, 1) 10000 Then
iRow2 = iRow2 + 1
Sheets(1).Rows(iCt).Copy Sheets(2).Rows(iRow2)
End If
Next iCt
End Sub
Hth,
Merjet
|