EXCEL redistibuer les lignes en colonnes

Option Explicit
Sub MiseEnFormeColonne()
    Dim Départ, Final
    Dim LigneDépart, ColonneDépart, LigneFinal
    Set Départ = ActiveWorkbook.Sheets("Départ")
    Set Final = ActiveWorkbook.Sheets("Final")
    
    LigneDépart = 1: ColonneDépart = 2: LigneFinal = 1
    Do While Départ.Cells(LigneDépart, 1) <> ""
        Do While Départ.Cells(LigneDépart, ColonneDépart) <> ""
            Final.Cells(LigneFinal, 1) = Départ.Cells(LigneDépart, 1)
            Final.Cells(LigneFinal, 2) = Départ.Cells(LigneDépart, ColonneDépart)
            LigneFinal = LigneFinal + 1
            ColonneDépart = ColonneDépart + 1
        Loop
        ColonneDépart = 2
        LigneDépart = LigneDépart + 1
    Loop
End Sub

Dans mon code, j'ai une feuille de départ nommée "Départ" et une feuille pour le résultat final "Final"
    Set Départ = ActiveWorkbook.Sheets("Départ")
    Set Final = ActiveWorkbook.Sheets("Final")
Les titres sont en A1 de la feuille Départ et j'écris en A1 de la feuille Final :
les données sont donc en colonne 2 (titre en A et données en B, C...)
    LigneDépart = 1: ColonneDépart= 2: LigneFinal = 1
    Do While Départ.Cells(LigneDépart, 1) <> ""
    Final.Cells(LigneFinal, 1) = Départ.Cells(LigneDépart, 1)
    Final.Cells(LigneFinal, 2) = Départ.Cells(LigneDépart, ColonneDépart)
    ColonneDépart = 2

Si tu démarres en C5 par exemple et que tu écris en Z10 :
les données sont donc en colonne 4 (titre en C et données en D, E...)
    LigneDépart = 5: ColonneDépart= 4: LigneFinal = 10
    Do While Départ.Cells(LigneDépart, 3) <> ""
    Final.Cells(LigneFinal, 26) = Départ.Cells(LigneDépart, 3)
    Final.Cells(LigneFinal, 27) = Départ.Cells(LigneDépart, ColonneDépart)
    ColonneDépart = 4