XL 2016 Transposer toutes les trois lignes l'un en dessous de l'autre

Sub Transpose_ListBox()
Dim tablo, ncol%, i&, j%, n&
With [A1].CurrentRegion
    tablo = .Resize(3 * Application.RoundUp(.Rows.Count / 3, 0)) 'matrice, plus rapide
End With
ncol = UBound(tablo, 2)
ReDim a(1 To ncol * UBound(tablo) / 3, 1 To 3)
For i = 1 To UBound(tablo) Step 3
    For j = 1 To ncol
        n = n + 1
        a(n, 1) = tablo(i, j)
        a(n, 2) = tablo(i + 1, j)
        a(n, 3) = tablo(i + 2, j)
Next j, i
If n Then ListBox1.List = a Else ListBox1.Clear
End Sub

Sub Coller()
Dim i&, n&
With Sheets("Coller")
    .Cells.Delete 'RAZ
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) Then
            n = n + 1
            .Cells(n, 1) = ListBox1.List(i, 0)
            .Cells(n, 2) = ListBox1.List(i, 1)
            .Cells(n, 3) = ListBox1.List(i, 2)
        End If
    Next
    .Columns.AutoFit 'ajuste les largeurs
    .Activate 'facultatif
End With
End Sub