Transposer colonne en lignes fractionnées

Bonjour à tous,

Un petit problème surement simple, mais je n y arrive pas.

J ai besoin de transposer une colonne en lignes, mais sur 3 colonnes et x lignes :

A Donnerait A. B. C chacun dans une colonne, puis D. E. F sur la ligne du desous, ...

B

C

D

E

F

Chaque cellule à transposer contient un long texte différent.

D avance merci à tous, heureusement que vous êtes là !

Bonjour Vincent,

Sub Macro2()
Dim i As Long, LastRw As Long, y As Integer
LastRw = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To LastRw Step 3
 For y = 1 To 3
   Cells(i, y + 1) = Cells(i + y - 1, 1)
 Next y
Next i
End Sub

Merci ! plus rapide que l'éclair

Ça fonctionne presque parfaitement pour moi, ça saute seulement 2 lignes entre chaque transposition, comment les supprime t-on ?

Suis vraiment nul, je n'arrive pas à le trouver dans le code...

une possibilité serait d'ajouter en colonne E, la valeur de i

ensuite trier par la colonne E, et supprimer la colonne E

Sub Macro2()
Dim i As Long, LastRw As Long, y As Integer
LastRw = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To LastRw Step 3
 For y = 1 To 3
   Cells(i, y + 1) = Cells(i + y - 1, 1)
 Next y
 Cells(i, y + 1) = i
Next i

    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("E1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("B1:E31")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("E:E").Delete Shift:=xlToLeft
    Range("A1").Select
End Sub

Merci SabV !

Ça fonctionne pour les 33 premières, puis ça saute 11 lignes et ça retranspose avec 2 lignes sautées jusqu'à la fin (j'ai mis un test avec mon texte en pj).

Une idée du pourquoi de ces sauts de lignes ?

Sinon très bonne idée l'indexation puis le tri automatique !

désolé, c'est un oublie, il faut remplacer la ligne

.SetRange Range("B1:E31")

par

.SetRange Range("B1:E" & LastRw)

Ça fonctionne parfaitement, merci !!!