Set FirstFound = searchRng.Find( _
what:=what, _
searchorder:=xlByRows _
)
'Alert and exit if name not found
If FirstFound Is Nothing Then
MsgBox "Name not found", vbExclamation, "Search & Deliver"
Exit Sub
End If
' Move First item
set NextFound = FirstFound
Do
' Move current item
NextFound.Resize(1, lastcol).Copy dest
Set dest = dest.Offset(1, 0)
' Search next item
Set NextFound = searchRng.FindNext(after:=NextFound)
Loop Until NextFound.Address = FirstFound.Address
End Sub

--
Regards,
Tom Ogilvy


"damorrison" wrote in message
oups.com...
Thanks alot for the example, it is exactly what I have been trying to
come up with; there seems to be a glitch though,
when there is only one item, it copies and pastes that item twice.



Sub SearchAndDeliver()

Dim what As String
Dim lastcol As Long
Dim searchRng As Range
Dim FirstFound As Range
Dim NextFound As Range
Dim dest As Range
Sheets("Sheet2").Select
ActiveCell.Cells.Select
Selection.ClearContents
Sheets("Sheet1").Select
ActiveCell.Offset(-4, 0).Range("A1").Select

'Input data to search
what = InputBox("Enter Name", "Search & Deliver")
If what = "" Then Exit Sub

'Initialize src data
With Worksheets("sheet1")
'Set search range
Set searchRng = .Range( _
.Range("A1"), _
.Cells(Rows.Count, "A").End(xlUp) _
)
'calculate last col to move
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
End With

'Initialize dest data
With Worksheets("Sheet2")
Set dest = .Cells(Rows.Count, "A").End(xlUp)
If dest.Value < "" Then Set dest = dest.Offset(1, 0)
End With

'Start searching
Set FirstFound = searchRng.Find( _
what:=what, _
searchorder:=xlByRows _
)
'Alert and exit if name not found
If FirstFound Is Nothing Then
MsgBox "Name not found", vbExclamation, "Search & Deliver"
Exit Sub
End If
' Move First item
FirstFound.Resize(1, lastcol).Copy dest
Set dest = dest.Offset(1, 0)
' Search next item
Set NextFound = searchRng.FindNext(after:=FirstFound)
'Loop until done
Do
' Move current item
NextFound.Resize(1, lastcol).Copy dest
Set dest = dest.Offset(1, 0)
' Search next item
Set NextFound = searchRng.FindNext(after:=NextFound)
Loop Until NextFound.Address = FirstFound.Address
End Sub