nochmal dynamische Datenüberprüfung

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Call Var_Bel 'Variablen Belegung 
    
    If Target.Row = 1 Then Exit Sub
    If Not Intersect(Columns(5), Target) Is Nothing Then
       '*** Nur, wenn nur eine Zelle ausgewählt ist 
        If Target.Count = 1 Then
            Call MachListe(Target)
        End If
    End If

End Sub

Private Sub MachListe(Zelle As Range)

    Lr05 = Tb05.Cells(Tb05.Rows.Count, 1).End(xlUp).Row
    Set RNG = Tb05.Cells(2, 1).Resize(Lr05, 1)

    'Liste erzeugen 
    Dim Z
    Liste = ""
    
    For Each Z In RNG
        If (WorksheetFunction.CountIf(Range("E:E"), Z.Value) = 0) Or Z = Zelle Then
            Liste = Liste & Z.Value & ","
        End If
    Next
     
    '*** Datenüberprüfung setzen 
     If Liste <> "" Then
         With Zelle.Validation
             .Delete
             .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                 Operator:=xlBetween, Formula1:=Liste
             .IgnoreBlank = False
             .InCellDropdown = True
             .ShowInput = True
             .ShowError = True
         End With
     End If
End Sub

Option Explicit
'*** Variable zur gemeinsamen Nutzung deklinieren 

Public Tb02 As Worksheet, Tb05 As Worksheet
Public Lr02 As Double, Lr05 As Double
Public RNG As Range, Liste As String

Public Belegt As Boolean 'Set nur 1x ausführen 

Sub Var_Bel()
    If Belegt = False Then
        Set Tb02 = ThisWorkbook.Sheets("Erfassung")
        Set Tb05 = ThisWorkbook.Sheets("KennListe")
        Belegt = True
    End If
End Sub