4 spalten in excel vergleichen

Const VonSpalte As Integer = 4 'Spalte D  
Const SpaltenAnzahl As Integer = 2

ZielSpalte = VonSpalte + SpaltenAnzahl

ZielSpalte = 10 'Spalte J  

Option Explicit

Sub Sammle()
Const MarkierungsZeile As Integer = 2
Const VonZeile As Integer = 3
Const VonSpalte As Integer = 2 'Spalte B  
Const SpaltenAnzahl As Integer = 4

Dim ZielSpalte As Integer
ZielSpalte = VonSpalte + SpaltenAnzahl
'oder fixe Angabe einer Spaltennummer  
'ZielSpalte = 10 'Spalte J  

Dim ErsteSpalte As Integer
Dim VonVergleich As Integer, BisVergleich As Integer
Dim i As Integer, j As Integer, k As Integer, z As Integer
Dim Nummer As Variant, ok As Boolean

ErsteSpalte = 0
For i = VonSpalte To VonSpalte + SpaltenAnzahl - 1
    If Cells(MarkierungsZeile, i).Value <> "" Then  
        ErsteSpalte = i
        Exit For
    End If
Next
If ErsteSpalte = 0 Then
    MsgBox "Keine Spalte markiert."  
    End
End If

'Zielspalte löschen (Achtung, ganze Spalte wird gelöscht)  
Cells(1, ZielSpalte).EntireColumn.ClearContents

VonVergleich = ErsteSpalte + 1
BisVergleich = VonSpalte + SpaltenAnzahl - 1
i = VonZeile
z = VonZeile
Do While Cells(i, ErsteSpalte).Value <> ""  
    Nummer = Cells(i, ErsteSpalte).Value
    ok = True
    For j = VonVergleich To BisVergleich
        If Cells(MarkierungsZeile, j).Value <> "" Then  
            k = VonZeile
            Do While Cells(k, j).Value <> "" And Cells(k, j).Value <> Nummer  
                k = k + 1
            Loop
            If Cells(k, j).Value <> Nummer Then
                ok = False
                Exit For
            End If
        End If
    Next
    If ok Then
        Cells(z, ZielSpalte).Value = Nummer
        z = z + 1
    End If
    i = i + 1
Loop
MsgBox "Fertig."  
End Sub

Option Explicit

Sub Sammle()
Const VonZeile = 2
Const VonSpalte As Integer = 1 'Spalte A  
Const SpaltenAnzahl As Integer = 4

Dim ZielSpalte As Integer, TempSpalte As Integer, LetzteErgebnisZeile As Integer
ZielSpalte = VonSpalte + SpaltenAnzahl
TempSpalte = ZielSpalte + 1

Dim i As Integer, j As Integer, k As Integer, v As Integer, z As Integer
Dim Nummer As Variant, ok As Boolean
Dim Bis As Integer
Bis = VonSpalte + SpaltenAnzahl - 1

Cells(1, ZielSpalte).EntireColumn.ClearContents
Cells(1, TempSpalte).EntireColumn.ClearContents

z = VonZeile - 1
For v = VonSpalte To Bis - 1
    i = VonZeile
    Do While Cells(i, v).Value <> ""  
        Nummer = Cells(i, v).Value
        For j = v + 1 To Bis
            ok = True
            k = VonZeile
            Do While Cells(k, j).Value <> "" And Cells(k, j).Value <> Nummer  
                k = k + 1
            Loop
            If Cells(k, j).Value <> Nummer Then
                ok = False
            End If
            If ok Then
                z = z + 1
                Cells(z, TempSpalte).Value = Nummer
            End If
        Next
        i = i + 1
    Loop
Next

LetzteErgebnisZeile = z
If LetzteErgebnisZeile > VonZeile Then
    Range(Cells(VonZeile, TempSpalte), Cells(LetzteErgebnisZeile, TempSpalte)).Sort (Cells(VonZeile, TempSpalte))
    z = VonZeile
    Cells(z, ZielSpalte).Value = Cells(z, TempSpalte).Value
    For i = VonZeile + 1 To LetzteErgebnisZeile
        If Cells(i, TempSpalte).Value <> Cells(i - 1, TempSpalte).Value Then
            z = z + 1
            Cells(z, ZielSpalte).Value = Cells(i, TempSpalte).Value
        End If
    Next
ElseIf LetzteErgebnisZeile = VonZeile Then
    Cells(VonZeile, ZielSpalte).Value = Cells(VonZeile, TempSpalte).Value
End If

Cells(1, TempSpalte).EntireColumn.ClearContents
MsgBox "Fertig."  
End Sub