Copy data from first workbook to a different workbook based on cell value in first

:help
I have a problem that I hope someone can help me with.

I have 2 workbooks that I am working with.
I wish to copy data from workbook 1 to workbook 2 based on the following criteria:

· A value in cell "B1" of workbook 1 needs to equal a value of a cell in column "A" of workbook 2... So it needs to find the corresponding cell with equal value of cell "B1" in column "A". Note the value in cell "B1" is the "key" for the records.

· Once the "key" has been found in row? in Workbook 2, i wish to paste the value in cell "D1" of workbook 1 into the cell in column "E" in this same row as the "key".

Is it possible to do this and if so how can I do this?

Can someone please help me?

Thanks

Regi

[vba]
Sub FindAndCopy()
Dim wb1 As Workbook, wb2 As Workbook
Dim foundCell As Range
Dim srcString As String
Dim foundRow As Long

Set wb1 = Workbooks("WorkBook1.xlsx")
Set wb2 = Workbooks("WorkBook2.xlsx")

srcString = wb1.Worksheets("Sheet1").Range("B1").Value

wb2.Activate
Worksheets("Sheet1").Activate

Set foundCell = Columns("A").Find(What:=srcString, After:=[A1], _
LookAt:=xlPart, SearchOrder:=xlByRows, LookIn:=xlValues, _
SearchDirection:=xlNext, MatchCase:=False)

If Not foundCell Is Nothing Then
foundRow = foundCell.Row
Range("E" & foundRow).Value = wb1.Worksheets("Sheet1").Range("D1").Value
Else
MsgBox "Search Item Not Found"
End If
End Sub[/vba]