Need Multiselect LIstBox to Split to new row instead of Word Wrap

Other than my "SplitString" function I couldn't test the code below for lack of supporting data. However, I am confident that you will be able to do any final adjustments should they be needed. Let me know if you need help.

Private Sub JLParaTransfer_Click()
    ' 16 Sep 2017
    
    Dim lItem As Long, lRows As Long, lCols As Long
    Dim bSelected As Boolean
    Dim lColLoop As Long, lTransferRow As Long
    Dim Sp() As String, i As Long
    Dim C As Long                           ' count columns
    
'    JLParaCB2.Value = False
    JLParaCB2.Value = True
    lTransferRow = 0
    lRows = JLParaLB2.ListCount - 1
    lCols = JLParaLB2.ColumnCount - 1
    For lItem = 0 To lRows
        If JLParaLB2.Selected(lItem) = True Then
           bSelected = True
           Exit For
        End If
    Next
    If bSelected = True Then
       With ActiveCell      ' ========= shouldn't this be ActiveSheet ?????
            For lItem = 0 To lRows             'Posts the new data
                If JLParaLB2.Selected(lItem) = True Then
                    lTransferRow = lTransferRow + 1
                    C = 1
                    For lColLoop = 0 To lCols
                        ' here: the maximum textbox width is 17
                        If SplitString(JLParaLB2.List(lItem, lColLoop), 17, Sp) Then
                            For i = 0 To UBound(Sp)
                                .Cells(lTransferRow, C) = Sp(i)
                                C = C + 1
                            Next i
                        End If
                    Next lColLoop
                End If
            Next
       End With
       UnHook_Mouse 'Turns off the mouse
       Unload Me
    End If
    JLParaCB2.Value = False
End Sub
Private Function SplitString(ByVal S As String, _
                             ByVal MaxChar As Long, _
                             Sp() As String) As Boolean
    ' 16 Sep 2017
    ' Sp() is assigned the split string
    ' function returns True if S was not null string
    
    Dim Fun() As String                 ' function return variable
    Dim i As Long
    Dim n As Long, m As Long
    
    ReDim Sp(100)                       ' guaranteed larger than required
    
    i = -1
    Do While Len(S)
        n = InStr(S, " ")
        If n = 0 Then n = MaxChar + 1
        m = InStr(S, "-")
        If m = 0 Then m = MaxChar + 1
        n = Application.Min(n, m, Len(S), MaxChar)
        i = i + 1
        Sp(i) = Left(S, n)
        S = Mid(S, n + 1)
    Loop
    
    If i >= 0 Then
        ReDim Preserve Sp(i)
        n = 0                               ' index of Fun()
        ReDim Fun(n)
        m = 0                               ' index of Sp()
        
        Do
            If Len(Fun(n)) + Len(Sp(m)) > MaxChar Then
                Fun(n) = Trim(Fun(n))
                n = n + 1
                ReDim Preserve Fun(n)
            End If
            Fun(n) = Fun(n) & Sp(m)
            m = m + 1
        Loop While m <= i
        
        Sp = Fun
        SplitString = True
    End If
End Function

Please take a look at the line "With ActiveCell" which I have marked. Note that the function "SplitString" splits on hyphen as well as space and could be expanded to split on Chr(160) if that is an issue with you. Observe that I put the maximum string length in the function call, not the function, so as to make the function itself more versatile.