Populate a single sheet with multiple entries from a drop down list

Here is the full code used by the userform:

Private Sub btn_AssignAll_Click()
    
    Dim wsList As Worksheet
    Dim wsRota As Worksheet
    
    Set wsList = Sheets("Lists")
    Set wsRota = Sheets("Rota")
    
    wsList.Range("A1").Resize(Me.list_UnassignedNames.ListCount).Value = Me.list_UnassignedNames.List
    If Me.list_AssignedNames.ListCount > 0 Then wsList.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(Me.list_AssignedNames.ListCount).Value = Me.list_AssignedNames.List
    With wsList.Range("A1", wsList.Cells(Rows.Count, "A").End(xlUp))
        .Sort .Cells, xlAscending, Header:=xlNo
        Me.list_UnassignedNames.Clear
        Me.list_AssignedNames.Clear
        Select Case (.Cells.Count > 1)
            Case True:  Me.list_AssignedNames.List = .Value
            Case Else:  Me.list_AssignedNames.AddItem .Value
        End Select
        .ClearContents
    End With
    
    Me.btn_AssignAll.Enabled = False
    Me.btn_AssignSelected.Enabled = False
    Me.btn_UnassignAll.Enabled = True
    Me.btn_UnassignSelected.Enabled = True
    
    Set wsList = Nothing
    Set wsRota = Nothing
    
End Sub

Private Sub btn_AssignSelected_Click()
    
    Dim wsList As Worksheet
    Dim wsRota As Worksheet
    Dim i As Long
    Dim bEnabled As Boolean
    
    Set wsList = Sheets("Lists")
    Set wsRota = Sheets("Rota")
    
    If Me.list_AssignedNames.ListCount > 0 Then wsList.Range("A1").Resize(Me.list_AssignedNames.ListCount).Value = Me.list_AssignedNames.List
    With Me.list_UnassignedNames
        For i = .ListCount - 1 To 0 Step -1
            If .Selected(i) Then
                wsList.Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = .List(i)
                .RemoveItem i
            End If
        Next i
    End With
    
    With wsList.Range("A1", wsList.Cells(Rows.Count, "A").End(xlUp))
        .Sort .Cells, xlAscending, Header:=xlNo
        Me.list_AssignedNames.Clear
        Select Case (.Cells.Count > 1)
            Case True:  Me.list_AssignedNames.List = .Value
            Case Else:  Me.list_AssignedNames.AddItem .Value
        End Select
        .ClearContents
    End With
    
    If Me.list_UnassignedNames.ListCount > 0 Then
        bEnabled = (Len(Me.list_UnassignedNames.List(0)) > 0)
    End If
    
    Me.btn_AssignAll.Enabled = bEnabled
    Me.btn_AssignSelected.Enabled = bEnabled
    Me.btn_UnassignAll.Enabled = True
    Me.btn_UnassignSelected.Enabled = True
    
    Set wsList = Nothing
    Set wsRota = Nothing
    
End Sub

Private Sub btn_UnassignAll_Click()
    
    Dim wsList As Worksheet
    Dim wsRota As Worksheet
    
    Set wsList = Sheets("Lists")
    Set wsRota = Sheets("Rota")
    
    wsList.Range("A1").Resize(Me.list_AssignedNames.ListCount).Value = Me.list_AssignedNames.List
    If Me.list_UnassignedNames.ListCount > 0 Then wsList.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(Me.list_UnassignedNames.ListCount).Value = Me.list_UnassignedNames.List
    With wsList.Range("A1", wsList.Cells(Rows.Count, "A").End(xlUp))
        .Sort .Cells, xlAscending, Header:=xlNo
        Me.list_AssignedNames.Clear
        Me.list_UnassignedNames.Clear
        Select Case (.Cells.Count > 1)
            Case True:  Me.list_UnassignedNames.List = .Value
            Case Else:  Me.list_UnassignedNames.AddItem .Value
        End Select
        .ClearContents
    End With
    
    Me.btn_AssignAll.Enabled = True
    Me.btn_AssignSelected.Enabled = True
    Me.btn_UnassignAll.Enabled = False
    Me.btn_UnassignSelected.Enabled = False
    
    Set wsList = Nothing
    Set wsRota = Nothing
    
End Sub

Private Sub btn_UnassignSelected_Click()
    
    Dim wsList As Worksheet
    Dim wsRota As Worksheet
    Dim i As Long
    Dim bEnabled As Boolean
    
    Set wsList = Sheets("Lists")
    Set wsRota = Sheets("Rota")
    
    If Me.list_UnassignedNames.ListCount > 0 Then wsList.Range("A1").Resize(Me.list_UnassignedNames.ListCount).Value = Me.list_UnassignedNames.List
    With Me.list_AssignedNames
        For i = .ListCount - 1 To 0 Step -1
            If .Selected(i) Then
                wsList.Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = .List(i)
                .RemoveItem i
            End If
        Next i
    End With
    
    With wsList.Range("A1", wsList.Cells(Rows.Count, "A").End(xlUp))
        .Sort .Cells, xlAscending, Header:=xlNo
        Me.list_UnassignedNames.Clear
        Select Case (.Cells.Count > 1)
            Case True:  Me.list_UnassignedNames.List = .Value
            Case Else:  Me.list_UnassignedNames.AddItem .Value
        End Select
        .ClearContents
    End With
    
    If Me.list_AssignedNames.ListCount > 0 Then
        bEnabled = (Len(Me.list_AssignedNames.List(0)) > 0)
    End If
    
    Me.btn_AssignAll.Enabled = True
    Me.btn_AssignSelected.Enabled = True
    Me.btn_UnassignAll.Enabled = bEnabled
    Me.btn_UnassignSelected.Enabled = bEnabled
    
    Set wsList = Nothing
    Set wsRota = Nothing
    
End Sub

Private Sub list_UnassignedNames_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    
    btn_AssignSelected_Click
    
End Sub

Private Sub list_AssignedNames_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    
    btn_UnassignSelected_Click
    
End Sub

Private Sub btn_OK_Click()
    
    Dim wsList As Worksheet
    Dim wsRota As Worksheet
    Dim i As Long
    
    Set wsList = Sheets("Lists")
    Set wsRota = Sheets("Rota")
    
    With Me.list_AssignedNames
        If .ListCount > 0 Then
            Select Case (Len(.List(0)) > 0)
                Case True: Selection.Value = Replace(Trim(Join(Application.Transpose(.List), "   ")), "   ", ", ")
                Case Else: Selection.ClearContents
            End Select
        Else
            Selection.ClearContents
        End If
    End With
    
    Set wsList = Nothing
    Set wsRota = Nothing
    
    Unload Me
    
End Sub

Private Sub btn_Cancel_Click()
    
    Unload Me
    
End Sub

Private Sub UserForm_Initialize()
    
    Dim wsList As Worksheet
    Dim wsRota As Worksheet
    Dim rCell As Range
    Dim strUsedNames As String
    Dim strUnassignedNames As String
    Dim strDate As String
    Dim strJob As String
    
    Set wsList = Sheets("Lists")
    Set wsRota = Sheets("Rota")
    
    For Each rCell In wsRota.Range(wsRota.Cells(4, Selection.Column), wsRota.Cells(Rows.Count, "A").End(xlUp).Offset(, Selection.Column - 1)).Cells
        Select Case (rCell.Address = Selection.Address)
            Case True:  Me.list_AssignedNames.List = Split(rCell.Text, ", ")
            Case Else:  strUsedNames = strUsedNames & ", " & rCell.Text & ", "
        End Select
    Next rCell
    
    For Each rCell In wsList.Range("list_Names").Cells
        If InStr(1, strUsedNames, rCell.Text, vbTextCompare) = 0 Then
            strUnassignedNames = strUnassignedNames & ", " & rCell.Text
        End If
    Next rCell
    
    With Me.list_UnassignedNames
        .List = Split(Mid(strUnassignedNames, 3), ", ")
        Me.btn_AssignAll.Enabled = (.ListCount > 0)
        Me.btn_AssignSelected.Enabled = (.ListCount > 0)
    End With
    
    With Me.list_AssignedNames
        Me.btn_UnassignAll.Enabled = (.ListCount > 0)
        Me.btn_UnassignSelected.Enabled = (.ListCount > 0)
    End With
    
    strDate = wsRota.Cells(3, Selection.Column).Text
    strJob = wsRota.Cells(Selection.Row, "A").Text
    Me.Caption = Me.Caption & strJob & " for " & strDate
    Me.lbl_Title.Caption = strJob & ": " & strDate
    
    Set wsList = Nothing
    Set wsRota = Nothing
    
End Sub

Private Sub UserForm_Terminate()
    Unload Me
End Sub