Incrémentation

Sub AnneeSuivante()
'se lance par les touches Ctrl+A
Dim nf$, num
nf = ActiveSheet.Name
If ActiveSheet.ListObjects.Count = 0 Or Not nf Like "####" Then Exit Sub
On Error Resume Next
Sheets(CStr(nf + 1)).Activate
On Error GoTo 0
'---création de l'année suivante---
If ActiveSheet.Name = nf Then
  num = Abs(Int(Val(InputBox("Entrez le premier numéro de l'année " & nf + 1 & " :"))))
  If num = 0 Then Exit Sub
  Application.ScreenUpdating = False
  Sheets.Add After:=Sheets(Sheets.Count)
  ActiveSheet.Name = nf + 1
  With Sheets(nf).ListObjects(1).Range.EntireColumn
    .Copy Columns(.Column)
    ActiveSheet.ListObjects(1).Name = "Tableau" & nf + 1 'nom du tableau mieux adapté...
    With ActiveSheet.ListObjects(1).DataBodyRange
      If .Rows.Count > 1 Then .Rows(2).Resize(.Rows.Count - 1).Delete xlUp
      .Value = ""
      .Cells(1) = "SXB***" & num & "/" & Right(nf + 1, 2)
      .Cells(1).Select
    End With
  End With
End If
End Sub

'---création de l'année suivante---
If ActiveSheet.Name = nf Then
  Do
    num = InputBox("Entrez 4 chiffres :", "Création " & nf + 1, IIf(num = "", "0000", num))
    If num = "" Then Exit Sub
  Loop While Not num Like "####"
  '-----