Option Explicit
Sub Copie_par_bloc()
Dim tablo, t(), NbreBloc As Long, j As Long, n As Long
Const bloc As Long = 3 '<- change
Application.ScreenUpdating = False
With Sheets("Feuil1")
tablo = .Range("a1", .Range("a" & Rows.Count).End(xlUp)).Value
End With
If UBound(tablo, 1) Mod bloc = 0 Then
NbreBloc = UBound(tablo, 1) \ bloc
Else
NbreBloc = UBound(tablo, 1) \ bloc + 1
End If
ReDim t(1 To NbreBloc, 1 To bloc)
For j = 1 To UBound(tablo, 1)
t((j - 1) \ bloc + 1, (j - 1) Mod bloc + 1) = tablo(j, 1)
Next
'Restitution en Feuille 2
With Sheets("Feuil2").Cells(1)
.CurrentRegion.ClearContents
For j = 1 To UBound(t, 1)
.Offset(, n).Resize(bloc, 1) = Application.Transpose(Application.Index(t, j, 0))
n = n + 1
Next
End With
Application.ScreenUpdating = True
End Sub