.. أقدم لكم الكود والحل وملف مرفق مطبق فيه الحل إن شاء الله
Sub Find_Duplicates_Sort_By_Similar_IDs()
Dim x, ws As Worksheet, sh As Worksheet, i As Long
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Worksheets(1)
Set sh = ThisWorkbook.Worksheets(2)
With sh
ws.Cells.Copy .Cells(1)
.Range("D1").Value = "Helper"
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
x = Application.Match(.Cells(i, 1), .Columns(8), 0)
If Not IsError(x) Then
.Cells(i, 4).Value = x
Else
.Cells(i, 4).Value = "TEMP " & Format(i, "000")
End If
Next i
.Range("A1").CurrentRegion.Sort Key1:=.Range("D4"), Order1:=xlAscending, Header:=xlYes
.Columns(4).ClearContents
End With
Application.ScreenUpdating = True
End Sub