Incrémentation d'une cellule sur des feuilles successives

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim i As Byte
On Error Resume Next 'sécurité
If Sh.Index = 1 And Source.Address = "$A$4" Then
  If IsNumeric(CStr(Source)) Then
    Application.ScreenUpdating = False 'fige l'écran
    For i = 1 To Sheets.Count
      Sheets(i).Name = i 'nomme provisoirement les feuilles 1 2 3 4...
    Next
    For i = 2 To Sheets.Count
      Sheets(i).[A4] = Sheets(i - 1).[A4] + 1 'ce qui redéclanche cette macro
    Next
  End If
End If
Sh.Name = Sh.Range("A1")
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
If Intersect(Source, Sh.[[COLOR="Red"]A1:[/COLOR]A4]) Is Nothing Then Exit Sub
Dim F As Object, i As Integer 'Integer au cas où le nombre de feuilles dépasse 254
Application.ScreenUpdating = False 'fige l'écran
On Error Resume Next
Set F = ActiveSheet
Worksheets(1).Activate
If F.Index > 1 Then [A4] = [A4] 'déclanche cette macro
If Sh.Index = 1 And IsNumeric(CStr([A4])) Then
  For i = 1 To Worksheets.Count
    Worksheets(i).Name = i 'nomme provisoirement les feuilles 1 2 3 4...
  Next
  For i = 2 To Worksheets.Count
    [COLOR="Red"]Worksheets(i).[A1:A3] = [A1:A3].Formula 'déclanche cette macro[/COLOR]
    Worksheets(i).[A4] = [A4] + i - 1 'déclanche cette macro
  Next
End If
Sh.Name = Sh.[A1]
F.Activate
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
If Intersect(Source, Sh.[A1:A4]) Is Nothing Then Exit Sub
Dim F As Object, nbase As Integer, i As Integer 'Integer au cas où le nombre de feuilles dépasse 254
Application.ScreenUpdating = False 'fige l'écran
On Error Resume Next
Set F = ActiveSheet
If Sh.[A2] = "" Then Sh.[A2] = Sheets(Sh.Index - 1).[A2] 'copie l'année
For nbase = Sh.Index - 1 To 1 Step -1
  If Worksheets(nbase).[A2] <> Sh.[A2] Then Exit For
Next
nbase = nbase + 1 'n° 1ère feuille de l'année
Worksheets(nbase).Activate
If F.Index <> nbase Then [A4] = [A4] 'déclanche cette macro
If Sh.Index = nbase And IsNumeric(CStr([A4])) Then
  For i = nbase To Worksheets.Count
    If Worksheets(i).[A2] <> [A2] Then Exit For
    Worksheets(i).Name = i 'nomme provisoirement les feuilles 1 2 3 4...
  Next
  For i = nbase + 1 To Worksheets.Count
    If Worksheets(i).[A2] <> [A2] Then Exit For
    Worksheets(i).[A1:A3] = [A1:A3].Formula 'déclanche cette macro
    Worksheets(i).[A4] = [A4] + i - nbase 'déclanche cette macro
  Next
End If
Sh.Name = Sh.[A1]
F.Activate
End Sub