Patrick

From your post it looks like you want to find a string and copy the
string and the cell adjacent to this string, so two cells. This can
be modified to suit.

Good luck

Chad

Sub FindIt()
Dim MyString As String

MyString = InputBox("Find what?")
'Find the string in the inputbox
Cells.Find(What:=MyString, After:=ActiveCell, LookIn:=xlFormulas,
LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False).Activate
'Sets the cells copied to 2, pastes the data as well.
ActiveCell.Resize(1, 2).Copy Sheets("sheet3").Range("A1")

End Sub