Sub Transpose()
Dim a, b(), i&, n%
With ActiveSheet 'à adapter
a = .UsedRange.Columns(1).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
ReDim b(1 To 1, 1 To UBound(a))
For i = 1 To UBound(a)
If a(i, 1) <> "" Then
n = n + 1
b(1, n) = a(i, 1)
End If
Next
'---restitution---
With .[C1] 'cellule de destination à adapter
If n Then .Resize(, n) = b
.Offset(, n).Resize(, .Parent.Columns.Count - n - .Column + 1).ClearContents 'RAZ à droite
End With
With .UsedRange: End With 'actualise la barre de défilement horizontale
End With
End Sub