you can also try the Find method (maybe faster)

Sub SearchAndCopy()

Dim varFind

Dim lngFoundRow As Long
Dim lngFirstRow As Long

Dim lngA As Long

Dim strSearch As String
Dim rngA As Range

strSearch = "TOOL"
lngA = Worksheets("destination").Cells(1, 1).CurrentRegion.Rows.Count +
1

With Worksheets("source")
Set varFind = .Columns(2).Find(strSearch, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not varFind Is Nothing Then
lngFirstRow = varFind.Row
Do
For Each rngA In .Rows(varFind.Row).Cells
Worksheets("destination").Cells(lngA,
rngA.Column).Value = .Cells(varFind.Row, rngA.Column).Value
Next rngA
Set varFind = .Columns(2).FindNext(varFind)
lngFoundRow = varFind.Row
lngA = lngA + 1
Loop While Not varFind Is Nothing And lngFoundRow <
lngFirstRow
End If
End With

End Sub

Kind regards,

hugo de wilde


--
H.A. de Wilde
------------------------------------------------------------------------
H.A. de Wilde's Profile: http://www.excelforum.com/member.php...o&userid=30679
View this thread: http://www.excelforum.com/showthread...hreadid=555185