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