here is the code
Sorry this is the code I am using!!
Sub MoveMatches()
Dim wsSrc As Worksheet
Dim wsFind As Worksheet
Dim wsDest As Worksheet
Dim rCell As Range
Dim rFound As Range
Set wsSrc = Workbooks("1.xls").Sheets(1)
Set wsFind = Workbooks("2.xls").Sheets(1)
Set wsDest = Workbooks("2.xls").Sheets(2)
For Each rCell In wsSrc.Columns(1).Cells
Set rFound = wsFind.Columns(2).Find(rCell.Value)
If Not rFound Is Nothing Then
rCell.EntireRow.Cut wsDest.Range("A65536").End
(xlUp).Offset(1, 0)
End If
Next rCell
End Sub
|