Transposer

[seb83100]

Bonsoir à tous et par avance merci du temps consacré à mon problème.

je vais essayer de vous expliquer mon soucis, je cherche à transposer avec une macro des lignes en colonnes.

je joins un fichier avec des explications.
En espérant avoir été assez explicite.

 

[klin89]

Re : Transposer

Bonsoir seb83100,

Du réchauffé

Sub test()
Dim a, i As Long, j As Long, b(), n As Long
    a = Sheets("Feuil1").Range("b4").CurrentRegion.Value
    ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 3)
    For j = 2 To UBound(a, 2)
        For i = 2 To UBound(a, 1)
            If Not IsEmpty(a(i, j)) Then
                n = n + 1
                b(n, 1) = a(1, j)
                b(n, 2) = a(i, 1)
                b(n, 3) = a(i, j)
            End If
        Next
    Next
    'Restitution
    With Sheets("Feuil2").Cells(1).Resize(n, 3)
        .CurrentRegion.ClearContents
        .Value = b
    End With
End Sub

klin89

 

[seb83100]

Re : Transposer

bonsoir et merci pour la solution à mon problème cela fonctionne comme je le souhaitais.

j'envisage de rajouter deux lignes au dessus de CLIENT et qui viendrait se situer en colonne à coté de CLIENT.
j'ai essayé mais je n'y suis pas arrivé.

par avance merci