Gültigkeitsliste als Dropdownfeld erweiterbar?

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Bereich B2:B20 überwachen  
If Not Intersect(Target, Range("B2:B20")) Is Nothing Then frmEingabe.Show  
'Alternative: Gesamte Spalte B überwachen  
'If Target.Column = 2 Then frmEingabe.Show  
End Sub

Option Explicit
'Position der Liste für Dropdown festlegen (Tabelle "Liste", ab Zelle A3):  
Const sListenBlatt As String = "Liste"  
Const ListeC As Integer = 1 'Spalte A  
Const ListeR As Integer = 3

Private Sub UserForm_Initialize()
Dim intTop As Integer
'Positionierung des Eingabeformulars  
intTop = ActiveCell.Top + 110
frmEingabe.Top = intTop
frmEingabe.Left = ActiveCell.Left
btnHinzu.Enabled = True
'Aktuellen Inhalt der Zelle in ComboBoxFeld übernehmen  
cboEintrag.Text = ActiveCell.Value
End Sub

Private Sub cboEintrag_Enter()
'Liste neu befüllen  
Dim R As Integer
cboEintrag.Clear
R = ListeR
Do While Sheets(sListenBlatt).Cells(R, ListeC).Value <> ""  
    cboEintrag.AddItem Sheets(sListenBlatt).Cells(R, ListeC).Value
    R = R + 1
Loop
End Sub

Private Sub cboEintrag_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 13
    Eintragen
Case 27 'Eingabe abbrechen, ohne den Inhalt der Zelle zu ändern  
    Unload Me
End Select
End Sub

Private Sub cboEintrag_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Eintragen
End Sub

Private Sub Eintragen()
ActiveCell.Value = cboEintrag.Text
'Cursor in nächste Zelle rechts setzen  
Cells(ActiveCell.Row, ActiveCell.Column + 1).Activate
Unload Me
End Sub

Private Sub cboEintrag_AfterUpdate()
'ComboBoxFeld hat neuen Inhalt erhalten, Hinzufügen ermöglichen  
btnHinzu.Enabled = True
End Sub

Private Sub cboEintrag_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Inhalt des ComboBoxFeldes hat sich geändert - Text kommt als neuer Listeneintrag in Frage  
btnHinzu.Enabled = True
End Sub

Private Sub btnHinzu_Click()
'Aktuellen Inhalt des ComboBoxFeldes der Liste hinzufügen  
Dim R As Integer, bAdd As Boolean, Index As Integer
If Trim(cboEintrag.Text) = "" Then  
    lblStatus.Caption = "<leer> nicht hinzugefügt."  
Else
    R = ListeR
    bAdd = True
    Do While Sheets(sListenBlatt).Cells(R, ListeC).Value <> ""  
        If Sheets(sListenBlatt).Cells(R, ListeC).Value = cboEintrag.Text Then
            bAdd = False
            Index = R - ListeR
        End If
        R = R + 1
    Loop
    If bAdd Then
        Sheets(sListenBlatt).Cells(R, ListeC).Value = cboEintrag.Text
        cboEintrag.AddItem cboEintrag.Text
        Sheets(sListenBlatt).Cells(ListeR, ListeC).Sort _
            Key1:=Sheets(sListenBlatt).Cells(ListeR, ListeC), _
            Order1:=xlAscending, Header:=xlNo, Orientation:=xlTopToBottom
        lblStatus.Caption = "<" & cboEintrag.Text & "> hinzugefügt."  
    Else
        lblStatus.Caption = "<" & cboEintrag.Text & "> war bereits vorhanden."  
        cboEintrag.SetFocus
        cboEintrag.ListIndex = Index
    End If
End If
'Weiteres Hinzufügen erst sinnvoll, wenn ComboBoxFeld neuen Inhalt erhalten hat  
btnHinzu.Enabled = False
End Sub