You can change this as required :-

'-------------------------------------------
Dim MyValue As Variant
Dim FoundCell As Object
Dim FromSheet As Worksheet
Dim FromRow As Long
Dim ToSheet As Worksheet
Dim ToRow As Long
'---------------------
Sub transfer_data()
'- select cell containing search value
'- and run this macro from there
Set ToSheet = Workbooks("Book1.xls").Worksheets("Sheet1"
'**amend**
Set FromSheet = ActiveSheet
'------------------
MyValue = ActiveCell.Value
FromRow = ActiveCell.Row
'------------------
'- **nb. set correct column to search
Set FoundCell = ToSheet.Columns(1).Find(MyValue, LookIn:=xlValues)
If FoundCell Is Nothing Then
MsgBox (MyValue & " not found.")
Else
ToRow = FoundCell.Row
'- transfer additional data. **Change column numbers a
required.
ToSheet.Cells(ToRow, 5).Value = FromSheet.Cells(FromRow
2).Value
ToSheet.Cells(ToRow, 6).Value = FromSheet.Cells(FromRow
3).Value
End If
End Sub
'------------------------------------------------

--
Message posted from http://www.ExcelForum.com