compare data and move it to new sheet

Try the following code...

sub MoveDup()
set x=range("B2:B18")
for each sheet in sheets(array("Sheet1","Sheet2")
for each cell in x
for each cell1 in x
if cell=cell1 then
cell.entirerow.select
selection.cut
Sheets("Sheet3").activate
Range("A1").offset(r,0).select
application.paste
r=r+1
cell1.entirerow.select
selection.cut
Sheets("Sheet3").activate
Range("A1").offset(r,0).select
application.paste
r=r+1
end if
next
next
next
End sub

Before running this code.. make a new worksheet "sheet3"


Don't forget, click *