Sammenligning af kolonner og find identiske datasæt

Jeg har tidligere fået hjælp til nedenstående kode.
Den oprindelige opgave lød som følger:

Jeg har to kolonner (A og B) med kontonumre. Der er mange sammenfald i de to kolonner. Jeg ønsker at få identiske ordrenumre til at stå ud for hinanden.

Jeg har brug for at få udvidet koden, således at der er 4 kolonner, hvor det ene data sæt: kolonne A og B indeholder kontonummer og navn, og det andet datasæt: D og E indeholder kontonummer og navn. De to datasæt skal sammenlignes og identiske ordrenumre placeres overfor hinanden.

Er der en som kan hjælpe?



Sub Makro1()
    Dim Data As Variant, RW(2) As Long, I As Long, N As Long, OK As Boolean, X As Long, Data1 As Variant
    RW(1) = Range("A65536").End(xlUp).Row + 1
    RW(2) = Range("B65536").End(xlUp).Row + 1
    Data = Range("A:B")
    Data1 = Range("G:H")

    Columns("A:A").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal
    Columns("B:B").Select
    Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal




    For I = 1 To UBound(Data)
        OK = False
        If IsEmpty(Data(I, 1)) Then Exit For

        For N = 1 To UBound(Data)

            If Data(I, 1) = Data(N, 2) Then
                If I <> N Then

                    For X = I To UBound(Data)
                        If IsEmpty(Data(X, 2)) Then
                            Data(X, 2) = Data(I, 2)
                            Exit For
                        End If
                    Next

                    Data(I, 2) = Data(N, 2)
                    Data(N, 2) = Empty
                    RW(2) = RW(2) + 1
                End If

                OK = True
                Exit For
            End If

        Next

        If Not OK Then

            For X = I To UBound(Data)
                If IsEmpty(Data(X, 2)) Then
                    Data(X, 2) = Data(I, 2)
                    Data(I, 2) = Empty
                    Exit For
                End If
            Next

        End If
    Next
    X = 1
   
    For I = 1 To UBound(Data)
        If IsEmpty(Data(I, 1)) And Not IsEmpty(Data(I, 2)) Then
            Data1(X, 2) = Data(I, 2)
            X = X + 1
        End If
        If Not IsEmpty(Data(I, 1)) And IsEmpty(Data(I, 2)) Then
            Data1(X, 1) = Data(I, 1)
            X = X + 1
        End If
    Next


    Range("A1").Activate
    Range("D:E") = Data
    Range("G:H") = Data1
End Sub