单元格的MultiSelect ListBox值

Question

我想要一个带有多选ListBox的UserForm。每个选定的ListBox值都应产生一个带有实际日期和文本框的新单元格。 这是我到目前为止所拥有的，但是它覆盖了我的旧条目。 感谢您的帮助！

Private Sub CommandButton1_Click()
Dim emptyRow As Long
Tabelle3.Activate
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
    Dim ws As Worksheet
    Dim rng As Range
    Dim lng1 As Long
    Dim lng2 As Long
    Dim str() As String
    Set ws = ThisWorkbook.Worksheets("Essen")
    Set rng = ws.Range("A2")

    lng2 = 0 ' count of selected items
    For lng1 = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(lng1) Then
            lng2 = lng2 + 1 ' increment counter
            ReDim Preserve str(1 To lng2) ' resize array...
            str(lng2) = Me.ListBox1.List(lng1) ' and add selected item

        End If

    Next lng1

    Cells(emptyRow, 1).Value = str(lng2)
    Cells(emptyRow, 2).Value = TextBox2.Value
    Cells(emptyRow, 3).Value = TextBox1.Value
    Cells(emptyRow, 4).Value = TextBox3.Value

    rng.Resize(lng2, 1).Value = Application.Transpose(str)

    UserForm1.Hide
End Sub