Private
Sub
Worksheet_Change(
ByVal
Target
As
Range)
Dim
loLetzte
As
Long
, i
As
Long
, strListe
As
String
If
Target.Column = 2
And
Target.Row > 3
Then
loLetzte = Cells(Rows.Count,
"B"
).
End
(xlUp).Row
For
i = 4
To
loLetzte
If
Cells(i,
"B"
) <>
""
Then
If
strListe = vbNullString
Then
strListe = Cells(i,
"B"
)
Else
strListe = strListe &
","
& Cells(i,
"B"
)
End
If
End
If
Next
i
End
If
With
Cells(2,
"F"
).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=strListe
.IgnoreBlank =
True
.InCellDropdown =
True
.InputTitle =
""
.ErrorTitle =
""
.InputMessage =
""
.ErrorMessage =
""
.ShowInput =
True
.ShowError =
True
End
With
End
Sub