Hallo, ah, dieses Symbol hab ich übersehen, my bad!

Hier nochmal der Code, schon mit den Änderungen von xlKing:

'Dropdown mit Mehrfachauswahl & Remove if Double

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lUsed As Long
If Target.Count > 1 Then GoTo exitHandler
If IsNumeric(Target) Then GoTo exitHandler
If IsDate(Target) Then GoTo exitHandler
If Target.HasFormula Then GoTo exitHandler

On Error GoTo exitHandler

If Target.Validation.Type <> 3 Then GoTo exitHandler

'x = (Target.Validation)
  

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeConstants)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

 If Not Intersect(Target, Me.Range("Verein")) Is Nothing Then Exit Sub


  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
  
If Target.Column >= 2 Then   '>=3 weil ab Spalte C

 If InStr(1, Target.Validation.Formula1, "=Liste") > 0 Then
 

    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
        lUsed = InStr(1, oldVal, newVal)
        If lUsed > 0 Then
            If Right(oldVal, Len(newVal)) = newVal Then
                Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
            Else
                Target.Value = Replace(oldVal, newVal & ", ", "")
            End If
        Else
            Target.Value = oldVal & ", " & newVal
        End If
     
        
      End If
    End If
  End If
End If

exitHandler:
  Application.EnableEvents = True

End Sub



Private Sub Worksheet_SelectionChange(ByVal Target As Range)   'open dropdown

Dim WshShell As Object
Set WshShell = CreateObject("WScript.Shell")

    If (Target.Column > 8) Then
        Call floating_buttons
    Else


    On Error GoTo Err1:
'If Target.Cells.Count = 1 Then

        If Target.Validation.InCellDropdown = True Then
        WshShell.SendKeys ("%{DOWN}")

        End If
'End If
    WshShell.SendKeys "%{down}" ', True
    'DoEvents
    'SendKeys "{SCROLLLOCK}"

Err1:
    'do nothing
    
End If
    
End Sub



'Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

Private Sub floating_buttons()
        
        'On Error GoTo 0
        
        
                With Cells(Windows(1).ScrollRow, Windows(1).ScrollColumn)
            CommandButton7.Top = .Top + 15
            CommandButton7.Left = .Left + 1270
        End With

                With Cells(Windows(1).ScrollRow, Windows(1).ScrollColumn)
            CommandButton8.Top = .Top + 80
            CommandButton8.Left = .Left + 1270
        End With

                With Cells(Windows(1).ScrollRow, Windows(1).ScrollColumn)
            CommandButton9.Top = .Top + 145
            CommandButton9.Left = .Left + 1270
        End With

                With Cells(Windows(1).ScrollRow, Windows(1).ScrollColumn)
            CommandButton10.Top = .Top + 210
            CommandButton10.Left = .Left + 1270
        End With

                With Cells(Windows(1).ScrollRow, Windows(1).ScrollColumn)
            CommandButton11.Top = .Top + 275
            CommandButton11.Left = .Left + 1270
        End With

                With Cells(Windows(1).ScrollRow, Windows(1).ScrollColumn)
            CommandButton12.Top = .Top + 340
            CommandButton12.Left = .Left + 1270
        End With

                With Cells(Windows(1).ScrollRow, Windows(1).ScrollColumn)
            CommandButton13.Top = .Top + 405
            CommandButton13.Left = .Left + 1270
        End With

End Sub