Move Duplicates to Result Sheet

[zmagic]

Hi,

Reference is Column D for duplicates if found move them to Result sheet, I have a huge database I need macro to speedup this.
Please some one help to resolve.
Sample data with Result sheet attached.
Thanks

[jolivanes]

You could try so.

Sub Maybe()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim i As Long
Set sh1 = Worksheets("Sheet1") '<----- Change name as required
Set sh2 = Worksheets("Result") '<----- Change name as required
Application.ScreenUpdating = False
sh2.UsedRange.Offset(1).ClearContents


With sh1
With .Cells(2, 9).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 1)
.Formula = "=COUNTIF(C[-5],RC[-5])"
.Value = .Value
End With

With .Range("$A$1").CurrentRegion
.AutoFilter
.AutoFilter Field:=9, Criteria1:=">1"
End With

With .UsedRange
Application.Intersect(.Offset(1, 0), .SpecialCells(xlCellTypeVisible)).Copy sh2.Cells(2, 1)
.AutoFilter
.Columns(9).ClearContents
End With
End With

With sh2
.Columns(9).ClearContents
For i = .Cells(.Rows.Count, 4).End(xlUp).Row - 1 To 2 Step -1
If .Cells(i, 4).Offset(1).Value <> .Cells(i, 4) Then .Cells(i, 1).Offset(1).Resize(, 8).Insert Shift:=xlDown
Next i
End With
Application.ScreenUpdating = True
End Sub

[jolivanes]

Thank you for taking the time to let us know that the suggestion worked for you.