Excel Tabellen Vergleich

Liebe Gemeinde,

ich habe einen VBA Code, dieser vergleicht eine Spalte mit anderen Spalten aus anderen Blättern.
Verglichen wird die Personalnummer.
Jetzt lasse ich den Code für jeden Sheet 1x ausführen(Sheet 2 und Sheet 5).
Der Code soll die Tabellen bzw. Spalten vergleichen und doppelte Einträge löschen.

Sheet 1= ausgeschiedene Mitarbeiter, Sheet 2= alle Mitarbeiter, Sheet 5=alle Mitarbeiter(mit Extras, eine Absolute Auswertung).
Personalnummer in Sheet1: Spalte B
Personalnummer in Sheet2: Spalte E
Personalnummer in Sheet5: Spalte D
Führe ich den Code aus, wird bei Sheet 5 alles sauber gelöscht, bei Sheet 2 hingegen nicht, dort löscht er einfach nicht alle ausgeschiedenen Mitarbeiter, auch wenn ich die pers.Nr in Sheet5 in Reihe D verschiebe...nichts
Ich verstehe das ganze nicht, ich habe im Code nur die Spalte angepasst und schon funktioniert es nicht mehr.

Code:

Public Sub DeleteDuplicates()
    Dim dic As Object, rngDelete As Range, cell As Range
    Set dic = CreateObject("Scripting.Dictionary")  
    'Referenztabelle mit Daten Spalte B in Dictionary laden  
    With Sheets(1)
        For Each cell In .Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)  
            strVal = cell.Value & "|" & cell.Offset(0, 2).Value  
            If Not dic.Exists(strVal) Then
                dic.Add strVal, ""  
            End If
        Next
    End With
    With Sheets(2)
        'Für jede belegte Zelle in Tabelle2  
        For Each cell In .Range("E2:E" & Cells(Rows.Count, "E").End(xlUp).Row)  
            strVal = cell.Value & "|" & cell.Offset(0, 2).Value  
            'prüfe ob Kombination im Dictionary existiert  
            If dic.Exists(strVal) Then
                'Füge Zeile zu einem kombinierten Range zusammen  
                If Not rngDelete Is Nothing Then
                    Set rngDelete = Union(rngDelete, cell.EntireRow)
                Else
                    Set rngDelete = cell.EntireRow
                End If
            End If
        Next
    End With
    'Lösche die gespeicherten Zeilen auf einen Rutsch  
    If Not rngDelete Is Nothing Then
        rngDelete.Delete
    End If
End Sub

Public Sub Wiederholen()
Dim dic As Object, rngDelete As Range, cell As Range
    Set dic = CreateObject("Scripting.Dictionary")  
    'Referenztabelle mit Daten Spalte B in Dictionary laden  
    With Sheets(1)
        For Each cell In .Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)  
            strVal = cell.Value & "|" & cell.Offset(0, 2).Value  
            If Not dic.Exists(strVal) Then
                dic.Add strVal, ""  
            End If
        Next
    End With
    With Sheets(5)
        'Für jede belegte Zelle in Tabelle5  
        For Each cell In .Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)  
            strVal = cell.Value & "|" & cell.Offset(0, 2).Value  
            'prüfe ob Kombination im Dictionary existiert  
            If dic.Exists(strVal) Then
                'Füge Zeile zu einem kombinierten Range zusammen  
                If Not rngDelete Is Nothing Then
                    Set rngDelete = Union(rngDelete, cell.EntireRow)
                Else
                    Set rngDelete = cell.EntireRow
                End If
            End If
        Next
    End With
    'Lösche die gespeicherten Zeilen auf einen Rutsch  
    If Not rngDelete Is Nothing Then
        rngDelete.Delete
    End If
End Sub