Cut/Paste duplicate rows?

[Guest]

I have a list of data in columns A:I. I need to find all duplicate rows in
the used range based on the data in col G, cut the duplicates and paste into
another worksheet in the workbook.

Can someone offer code to accomplish this? Thanks!

 

[Guest]

Sub ABC()
Dim rng As Range, rng1 As Range
Set rng = Intersect(ActiveSheet.UsedRange.EntireRow, _
ActiveSheet.Columns(10))
rng.Formula = "=if(Countif($G$1:G1,G1)>1,na(),"""")"
On Error Resume Next
Set rng1 = rng.SpecialCells(xlFormulas, xlErrors)
On Error GoTo 0
If Not rng1 Is Nothing Then
rng1.EntireRow.Copy Worksheets("Sheet2").Range("A1")
rng1.EntireRow.Delete
Worksheets("Sheet2").Columns(10).ClearContents
End If
ActiveSheet.Columns(10).ClearContents
End Sub

 

[Guest]

Thanks Tom!! It worked like a charm with one caveat (and this is because I
wasn't clear in the original post): this routine leaves behind one of the
duplicate rows.

Lets say I have 3 rows that have the same data in col G, is it possible to
cut and past all 3 rows into the other sheet?

Thanks!