Had to move the set sd and dd til after workbook activated. but for the most
part the code works to copy data; however, it seems to skip a few lines. It
may be because not all the data is congruant. Also I would like the macro to
paste a line back to origonal cell rather then just the data.

Sub FindMatchesInBooks()
Dim swb As Workbook, dwb As Workbook
Dim sd As Worksheet, dd As Worksheet
Dim cell As Range, x As Long
Dim LastRowS As Long, LastRowD As Long
Application.ScreenUpdating = False
Set swb = Workbooks("Source.xlsm") ' change to source data filename
Set dwb = Workbooks("destinatio.xlsx") ' change to destination data
filename
swb.Activate
Set sd = Worksheets("Sheet 5") 'Source worksheet
sd.Activate
LastRowS = Cells(Cells.Rows.Count, "L").End(xlUp).Row
Set rngS = Range("L2:L" & LastRowS)
dwb.Activate
Set dd = Worksheets("Sheet 3") ' Destination worksheet
dd.Activate
LastRowD = Cells(Cells.Rows.Count, "B").End(xlUp).Row
For x = 2 To LastRowD
For Each cell In rngS
If dd.Cells(x, 2).Value = cell.Value Then
dd.Cells(x, 13).Formula = cell.Offset(0, -6).Value 'Sets column
M source to column F
dd.Cells(x, 14).Formula = cell.Offset(0, -4).Value 'Sets column
N source to column H
dd.Cells(x, 15).Formula = cell.Offset(0, -2).Value 'Sets Column
O source to column J
dd.Cells(x, 16).Formula = cell.Offset(0, -1).Value 'Sets Column
P source to column K
End If
Next
Next x
Application.ScreenUpdating = True
MsgBox "DOne"
End Sub


"J_Knowles" wrote:

Okay, this code is for the source & destination in separate workbooks.
The first try was for one workbook with 2 worksheets.

Sub FindMatchesInBooks()
Dim swb As Workbook, dwb As Workbook
Dim sd As Worksheet, dd As Worksheet
Dim cell As Range, x As Long
Dim LastRowS As Long, LastRowD As Long
Application.ScreenUpdating = False
Set swb = Workbooks("SourceData.xlsx") ' change to your workbook name
Set dwb = Workbooks("FindValuesSh1-CopyToSht2.xlsm") ' change filename
Set sd = Worksheets("source")
Set dd = Worksheets("destination")
swb.Activate
sd.Activate
LastRowS = Cells(Cells.Rows.Count, "L").End(xlUp).Row
Set rngS = Range("L2:L" & LastRowS)
dwb.Activate
dd.Activate
LastRowD = Cells(Cells.Rows.Count, "B").End(xlUp).Row
For x = 2 To LastRowD
For Each cell In rngS
If dd.Cells(x, 2).Value = cell.Value Then
dd.Cells(x, 14).Formula = cell.Offset(0, -4).Value
dd.Cells(x, 15).Formula = cell.Offset(0, -2).Value
dd.Cells(x, 16).Formula = cell.Offset(0, -1).Value
End If
Next
Next x
Application.ScreenUpdating = True
End Sub

HTH
--
Data Hog