Bonjour à tous,
essaye ce code dans un module :
Sub transpos()
Application.ScreenUpdating = False
Range("A2").Select
Do While ActiveCell.Offset(0, 1) <> ""
Range(ActiveCell, ActiveCell.Offset(2, 0)).Copy Destination:=ActiveCell.Offset(0, 4)
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(2, 1)).Copy
ActiveCell.Offset(0, 5).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
Application.CutCopyMode = False
ActiveCell.Offset(3, -5).Select
Loop
End Sub
amicalement
Claude.