XL 2013 [Résolu] ListBox avec sauts de lignes multi-colonnes

Dim Rng, TblBD()
Private Sub UserForm_Initialize()
     Set f = Sheets("BD")
     Set Rng = f.Range("A2:F" & f.[A65000].End(xlUp).Row)
     TblBD = Rng.Value
     Me.ListBox1.ColumnCount = Rng.Columns.Count
     'Me.ListBox1.ColumnWidths = "50;50;150;150;150"
     '--- alim combobox
     Set d = CreateObject("Scripting.Dictionary")
     d("*") = ""
     For i = LBound(TblBD) To UBound(TblBD)
        d(TblBD(i, 2)) = ""
     Next i
     Me.ComboBox1.List = d.keys
     Me.ComboBox1 = "*"
     EnTeteListBox
     Filtre
End Sub

Private Sub ComboBox1_click()
  Filtre
End Sub

Sub Filtre()
     Dim TblBD2()
     NbColCmt = 4      ' adapter
     ligne = 0
     Dim a(): ReDim a(1 To NbColCmt)
     clé = Me.ComboBox1: colClé = 2
     For i = 1 To UBound(TblBD)
        If TblBD(i, colClé) Like clé Then
          ligne = ligne + 1
          ReDim Preserve TblBD2(1 To UBound(TblBD, 2), 1 To ligne)
          TblBD2(1, ligne) = TblBD(i, 1): TblBD2(2, ligne) = TblBD(i, 2)
          ReDim TblM(1 To 20, 1 To NbColCmt)
          For k = 1 To NbColCmt
            a(k) = Split(TblBD(i, k + 2), vbCrLf)
            For lig = 0 To UBound(a(k)): TblM(lig + 1, k) = a(k)(lig): Next lig
            If UBound(a(k)) > mx Then mx = UBound(a(k))
          Next k
          For j = 0 To mx
            ReDim Preserve TblBD2(1 To UBound(TblBD, 2), 1 To ligne)
            For k = 1 To NbColCmt: TblBD2(k + 2, ligne) = Replace(TblM(j + 1, k), vbCrLf, ""): Next k
            ligne = ligne + 1
          Next j
        End If
     Next i
     Me.ListBox1.Column = TblBD2
End Sub