Sub NumeroPourTri()
Dim S As Worksheet
Dim R As Range
Dim NbLig&
Dim Tranche&
Dim Pas&
Dim i&
Dim cpt&
Dim T()
ActiveSheet.Copy after:=Sheets(Sheets.Count)
Set S = ActiveSheet
Set R = S.[a1].CurrentRegion
NbLig& = R.Rows.Count - 1
Tranche& = NbLig& \ 4
If Tranche& * 4 < NbLig& Then Tranche& = Tranche& + 1
ReDim T(1 To NbLig&, 1 To 1)
Pas& = 1
For i& = 1 To NbLig&
T(i&, 1) = Pas&
Pas& = Pas& + 4
If i& Mod Tranche& = 0 Then
cpt& = cpt& + 1
Pas& = cpt& + 1
End If
Next i&
Set R = S.Range(S.Cells(2, R.Columns.Count + 1), S.Cells(NbLig& + 1, R.Columns.Count + 1))
R = T
End Sub