Macro: Move Duplicate Rows From One Worksheet To Another

Try this

Sub test()
    Dim dic As Object, i As Long, x As Range
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    With Sheets("sheet1").Cells(1).CurrentRegion
        For i = 2 To .Rows.Count
            If Not dic.exists(.Cells(i, 1).Value) Then
                dic(.Cells(i, 1).Value) = Empty
            Else
                If x Is Nothing Then
                    Set x = .Rows(i)
                Else
                    Set x = Union(x, .Rows(i))
                End If
            End If
        Next
        If Not x Is Nothing Then
            Union(.Rows(1), x).Copy Sheets("sheet2").Cells(1)
            x.EntireRow.Delete
        End If
    End With
End Sub

Originally Posted by jindon

Try this
...

Thank you, that is much closer to what I am trying to do;
however, if you compare the result produced by your function
to the desired result that I uploaded as Workbook2, you will
see that they are not quite the same.

Perhaps I did not make it clear, but a row should be considered
to be a duplicate only if it is identical, in every column, to some
other row.