Give this a try
Sub abc()
Const shSras As String = "SRAS"
Const shDupes As String = "SRASDup"
Dim a, i As Long, myRng As Range
With Worksheets(shSras)
a = .Range("a1").CurrentRegion
End With
With CreateObject("scripting.dictionary")
.comparemode = 1
For i = 1 To UBound(a)
If Not .exists(a(i, 1)) Then
.Item(a(i, 1)) = a(i, 1)
Else
With Worksheets(shSras)
If myRng Is Nothing Then
Set myRng = .Cells(i, "A")
Else
Set myRng = Union(myRng, .Cells(i, "A"))
End If
End With
End If
Next
End With
With Worksheets(shDupes)
If Not myRng Is Nothing Then
myRng.EntireRow.Copy .Range("a2")
myRng.EntireRow.Delete
End If
End With
End Sub
Bookmarks