Salut,
On peut le faire pas tableaux VBA, colles ceci dans un module standard, à toi de rajouter la mise en forme dans le nouveau classeur si tu le désires.
Sub Princ()
Dim T, C As Workbook
T = Worksheets(1).Range("A1:O10000").Value 'Plage à adpater
T = SupprLigVides(T, 1) '1 puisque c'est sur la colonne A
T = InverseTab(T)
Set C = Workbooks.Add(xlWBATWorksheet)
With C
With .Worksheets(1)
.[A5].Resize(UBound(T) + 1, UBound(T, 2) + 1) = T
End With
End With
End Sub
Function SupprLigVides(T, Col As Byte)
Dim I&, J&, K&, Temp
ReDim Temp(UBound(T, 2) - 1, K)
For I = LBound(T) To UBound(T)
If T(I, Col) <> "" Then
For J = LBound(T, 2) To UBound(T, 2)
Temp(J - 1, K) = T(I, J)
Next J
K = K + 1
ReDim Preserve Temp(UBound(T, 2) - 1, K)
End If
Next I
SupprLigVides = Temp
End Function
Function InverseTab(T, Optional Base As Byte = 0)
Dim Temp(), I&, J&
ReDim Temp(Base To UBound(T, 2), Base To UBound(T))
For I = LBound(T, 2) To UBound(T, 2)
For J = LBound(T) To UBound(T)
Temp(I, J) = T(J, I)
Next J
Next I
InverseTab = Temp
End Function
A+++
Lien supprimé