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