Private Sub Worksheet_Activate()
Dim lig As Long, a As Range
lig = 1
Application.ScreenUpdating = False
On Error Resume Next 'si Feuil1 est vide
For Each a In Feuil1.[A:A].SpecialCells(xlCellTypeConstants).Areas
Rows(lig).Clear
a.Copy
Cells(lig, 1).PasteSpecial xlPasteAll, Transpose:=True
Cells(lig, 1).Delete xlToLeft
lig = lig + 5
Next
[A1].Select
Rows(lig & ":" & Rows.Count).Clear
End Sub