البحث عن التكرار وترتيب البيانات بناءً على الأكواد المتشابهة Find Duplicates Sort By Similar IDs

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