[XL 2010] VBA Comment transposé un tableau "complexe" en ligne et en colonne

Sub transposer()

    Dim PlageSource As Range
    Dim FeuilleResultat As Worksheet

    Dim NumColonneResultat As Integer
    Dim NumLigneResultat As Integer
    Dim Cell As Range
    Dim Un As Collection
    Dim i As Long
 
    ' nommer tous les endroits sur lesquels on travaille. ca permettra de modifier plus facilement plus tard
    Set PlageSource = Workbooks("classeur10.xlsm").Worksheets("test").Range("A3:E8")
    Set FeuilleResultat = Workbooks("classeur10.xlsm").Worksheets("test2")
     NumColonneResultat = 2
     NumLigneResultat = 1
 
    ' creer une liste sans doublons, d'après un tuto de Silkyroad
    Set Un = New Collection
    On Error Resume Next
    'Boucle sur la plage de cellule
    For Each Cell In PlageSource
        'If Cell <> "" Permet de ne pas prendre en compte les cellules vides
        'Un.Add Cell, CStr(Cell) Ajoute le contenu de la cellule dans la collection
        'le 2ème argument Cstr(cell) est le TAG de l'élément. Le tag est unique, c'est ca qui évite les doublons
        'ici on choisi le contenu de la cellule, transformé en chaine de caractere (par Cstr)
        If Cell <> "" Then Un.Add Cell, CStr(Cell)
    Next Cell
    On Error GoTo 0
 
    'Boucle sur les éléments de la collection
    'les écrire dans feuille2, en chagneant de colonne à chaque fois
    For i = 1 To Un.Count
        FeuilleResultat.Cells(NumLigneResultat + i - 1, NumColonneResultat) = CStr(Un(i).Value)
    Next i
 
    Set Un = Nothing
End Sub

Sub Test()
Dim i&, J&, L&
Dim TReport As Variant, TData As Variant, TAlea As Variant
Dim RngAlea As Range
L = 1
With Sheets("SOURCE")
    TData = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(3).Offset(, 8))
    Set RngAlea = .Range(.Cells(2, 11), .Cells(2, .Columns.Count).End(1).Offset(UBound(TData, 1), 0))
End With
TAlea = RngAlea
nbLigne = Application.CountA(RngAlea)
ReDim TReport(1 To nbLigne, 1 To (UBound(TData, 2) + 2))
For J = 1 To UBound(TData, 2)
    TReport(1, J) = TData(1, J)
Next J
TReport(1, UBound(TData, 2) + 1) = "Titre"
TReport(1, UBound(TData, 2) + 2) = "Titre2"
For i = 2 To UBound(TData, 1)
    For J = 1 To UBound(TAlea, 2)
        If TAlea(i, J) <> "" Then
            L = L + 1
            For k = 1 To UBound(TData, 2)
                TReport(L, k) = TData(i, k)
            Next k
            TReport(L, k) = TAlea(1, J)
            TReport(L, k + 1) = TAlea(i, J)
        End If
    Next J
Next i
With Sheets("CIBLE")
    .Cells(3, 1).CurrentRegion.ClearContents
    .Cells(3, 1).Resize(UBound(TReport, 1), UBound(TReport, 2)) = TReport
    .Activate
End With
End Sub