Répartir des données sur un intervalle de temps

Sub travdem()
Dim Cellule1 As Range
Dim Nomfeuille1 As String, Col1 As String
Dim Nb0 As Integer, I As Integer
Dim valeur As Long

'parametre
Nomfeuille1 = "Feuil1"
Col1 = "b"
'code
With Sheets("Feuil1") '(Nomfeuille1)(ActiveSheet.Name)

For Each Cellule1 In .Range(Col1 & "2:" & Col1 & .Range(Col1 & .Rows.Count).End(xlUp).Row)
    If Cellule1 = 0 Then
        Nb0 = Nb0 + 1
    End If
    If Cellule1 <> 0 Then
        valeur = Cellule1 / (Nb0 + 1)
        For I = Nb0 To 0 Step -1
            Cellule1.Offset(-I, 2) = valeur 
        Next I
        Cellule1.Offset(0, 1) = valeur
        Nb0 = 0
    End If
    
Next Cellule1

End With
End Sub