Fonction transposee

Sub transpose_Multiple()
Dim NomTableau(), Mplage As Range, Cpt As Long
Dim F1 As Worksheet, i As Long, Derlig As Long, j As Integer, Dercol As Integer

Set F1 = ActiveSheet ' Definir la feuille
Const Ligne As Integer = 1
Const Colonne As Integer = 1

With F1
    Dercol = .Range("A1", .Cells(Ligne, .Columns.Count).End(xlToLeft)).Columns.Count
    Derlig = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
    ReDim NomTableau(1 To Derlig * Dercol, 1 To 1)
    
    For i = Ligne To Derlig
        For j = Colonne To Dercol
            If .Cells(i, j) <> Empty Then
            Cpt = Cpt + 1
            NomTableau(Cpt, 1) = .Cells(i, j)
            End If
        Next j
    Next i
    
    Set Mplage = .Range(.Cells(Ligne, Colonne), .Cells(Derlig, Dercol))
    Mplage.ClearContents
    Set Mplage = .Range(.Cells(Ligne, Colonne), .Cells(Cpt, Colonne))
    Mplage = NomTableau
End With

Fin:
Set Mplage = Nothing: Set F1 = Nothing
End Sub