basculer affichage vertical a horizontal pour donnees

Sub copytranspose()
lig = 1
[F1:I65000].ClearContents
Cells(lig, 6) = "Nom": Cells(lig, 7) = "Adresse": Cells(lig, 8) = "CP Ville": Cells(lig, 9) = "Tél"
For k = 5 To 65000 Step 6
If Cells(k, 2) = "" Then Exit For
lig = lig + 1
Cells(lig, 6) = Cells(k, 2): Cells(lig, 7) = Cells(k + 1, 2)
Cells(lig, 8) = Cells(k + 2, 2): Cells(lig, 9) = Cells(k + 3, 2)
Next
Range("F1:I1").AutoFilter
End Sub

Sub transpose()
  fin = [B65000].End(xlUp).Row
  Dim a()
  ReDim a(1 To (fin - 4) / 6, 1 To 4)
  For i = 5 To fin Step 6
    For k = 0 To 3: a((i + 1) / 6, k + 1) = Cells(i + k, 2): Next k
  Next i
  [f2].Resize((fin - 4) / 6, 4) = a
End Sub