VBA - Mehrfachauswahl Drop Down

[Elex]

Hi

Zwei Fehler.

Etwas zu viel aus meinem Code entfernt. 

Deine Zeitstempel Geschichte   (If Intersect(Target, Range("M1:M1000")) Is Nothing Then Exit Sub)   verhindert dass es je über Zeile 1 hinausgeht wenn nicht Spalte M im Spiel ist. Habe die jetzt mal deaktiviert.

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

'Zeitstempel
'If Intersect(Target, Range("M1:M1000")) Is Nothing Then Exit Sub
'If Cells(Target.Row, 13) Is Nothing Then
'Cells(Target.Row, 14).Value = ""
'Else
'Cells(Target.Row, 14) = Now
'End If


'** Mehrfachauswahl über DropDown-Liste (Gültigkeitsprüfung)
'** Einfügen im Code-Container des betreffenden Arbeitsblattes

'** Dimensionierung der Variablen
Dim rngDV As Range
Dim wertold As String
Dim wertnew As String

'** Errorhandling
On Error GoTo Errorhandling

'** Mehrfachauswahl im definierten Bereich (Bsp. B4:B14) durchführen
If Not Application.Intersect(Target, Range("D1:D1000")) Is Nothing Then

  '**Range definieren
  Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
  If rngDV Is Nothing Then GoTo Errorhandling

  '** Prüfen, ob eine gültige Zelle ausgewählt wurde und Werte eintragen
  If Not Application.Intersect(Target, rngDV) Is Nothing Then
    Application.EnableEvents = False
    wertnew = Target.Value '** trägt das ausgewählte in die Variable "wertnew" ein
    If wertnew <> "" Then
      Application.Undo '** macht es sofort rückgängig
      wertold = Target.Value '** es wird geguckt was vorher drin stand und wird in die Variable "wertold" eingetragen
      If wertold = "" Then
         Target.Value = wertnew
      Else
         Target.Value = wertold & ", " & wertnew
      End If
    End If
  End If

End If
Errorhandling:
Application.EnableEvents = True

End Sub

Gruß Elex

[SteBen]

PERFEKT - DANKEE!!!