View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Mary[_6_] Mary[_6_] is offline
external usenet poster
 
Posts: 8
Default 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