Public Sub Test()
Feuil3.Columns("C").ClearContents
With Intersect(Feuil3.Columns("D"), Feuil3.UsedRange.EntireRow)
.Rows(1).Value = 1
.Rows(2).Resize(.Rows.Count - 1).FormulaR1C1 = "=IF(RC2=R[-1]C2,R[-1]C+1,1)"
.Value = .Value
.NumberFormat = "0000"
End With
End Sub