XL 2016 Transposition d'un tableau à double entrée.... Macro ?

Sub Transposer()
Dim TabInit() As Variant
Dim TabFinal() As Variant
With Sheets("Initial")
    Lastline = .Range("A" & .Rows.Count).End(xlUp).Row
    LasCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    '.Range("A1").Resize(Lastline, LasCol).Select
    TabInit = .Range("A1").Resize(Lastline, LasCol).Value
    ReDim TabFinal(1 To UBound(TabInit, 1) * UBound(TabInit, 2), 1 To 4)
End With
indi = 1
For i = LBound(TabInit, 1) + 1 To UBound(TabInit, 1)
    TabFinal(indi, 1) = TabInit(i, 1)
    TabFinal(indi, 2) = TabInit(i, 2)
    For j = 3 To UBound(TabInit, 2)
        TabFinal(indi, 4) = TabInit(i, j)
        TabFinal(indi, 3) = TabInit(1, j)
        indi = indi + 1
        TabFinal(indi, 1) = TabInit(i, 1)
        TabFinal(indi, 2) = TabInit(i, 2)
    Next j
    
Next i
Sheets("Souhait").Range("A2").Resize(UBound(TabFinal, 1), UBound(TabFinal, 2)) = TabFinal
End Sub