Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim iLastRow As Long
Dim DropDown As Object
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
j = 0
For k = 0 To ListBox17.ListCount - 1
If ListBox17.Selected(k) Then
Range("B9").Offset(j, 0) = ListBox17.List(k)
j = j + 1
End If
Next k
l = ""
For k = 0 To ListBox17.ListCount - 1
If ListBox17.Selected(k) Then
l = l & ListBox17.List(k) & ","
End If
Next k
Range("F3") = l
' Dim j As Long
' For j = 1 To 15
' Me.ListBox17.TopIndex = Me.ListBox17.ListCount - 1
' Application.Wait Now + TimeSerial(0, 0, 1)
' Next j
Set DropDown = ActiveSheet.Shapes("Drop Down 13").ControlFormat
i = DropDown.Value
If Target.Address = "$B$19" Then
Application.EnableEvents = False
On Error GoTo ws_exit:
With Worksheets("Bau")
iLastRow = .Range("B" & Rows.Count).End(xlUp).Row + 1
.Cells(iLastRow, "B").Value = Range("B1").Value
.Cells(iLastRow, "C").Value = Range("B4").Value
.Cells(iLastRow, "D").Value = Range("B5").Value
.Cells(iLastRow, "E").Value = Range("B7").Value
.Cells(iLastRow, "F").Value = ListBox.List(l)
' .Cells(iLastRow, "F").Value = Range("B9").Value
.Cells(iLastRow, "G").Value = DropDown.List(i)
.Cells(iLastRow, "H").Value = Range("B13").Value
.Cells(iLastRow, "I").Value = Range("B15").Value
.Cells(iLastRow, "J").Value = Range("B17").Value
.Cells(iLastRow, "K").Value = Range("B19").Value
Range("B1:B21").ClearContents
End With
End If
ws_exit:
Application.EnableEvents = True
Exit Sub
End Sub
