Option Explicit
Sub NouvelleAnnee()
Dim Couleur, cel As Range, p As Byte, An0%, An1%, An2%
If [A2].Comment Is Nothing Then
MsgBox "il n'y a pas de commentaire ! Action terminée.": Exit Sub
End If
Couleur = Array(3, 5, 43, 6, 7, 33, 29, 27, 38, 46, 26, 6)
Const plg1 As String * 27 = "A1, G1, B2, D2, H2, G16, J2"
Const plg2 As String * 18 = "C2, D2, G2, J2, A3"
Application.ScreenUpdating = False
An1 = Val(Split(ActiveSheet.Name, " ")(1))
If An1 = 0 Then MsgBox "Nom de la Feuille non Conforme": Exit Sub
ActiveSheet.Copy , Sheets(Sheets.Count): An0 = An1 - 1: An2 = An1 + 1
On Error GoTo ErrNomFeuille 'ça arrive si le nouveau nom existe déjà
With ActiveSheet 'onglet de la NOUVELLE année
.Unprotect: .Name = "Année " & An2
.Tab.ColorIndex = Couleur((An2 - 2000) Mod 12)
End With
With [E3]
.Formula = "='Année " & An1 & "'!E15": .Locked = -1: .FormulaHidden = -1
End With
For Each cel In Range(plg1)
p = InStr(cel.Value, An1): cel.Characters(p, 4).Text = An2
Next cel
If Not [F2].Comment Is Nothing Then _
[F2].Comment.Shape.TextFrame.Characters(35, 4).Text = An2
For Each cel In Range(plg2)
p = InStr(cel.Value, An0): cel.Characters(p, 4).Text = An1
Next cel
[A2].Comment.Shape.TextFrame.Characters(31, 4).Text = An1
'attention : mettre en commentaire pour ne pas effacer
'le bouton "nouvelle année" de la Feuille Précédente
'ActiveSheet.Shapes("AnneePlus").Delete
Range("E4:F15, H4:I15").ClearContents: [A1].Select
ActiveSheet.Protect: Exit Sub
ErrNomFeuille:
MsgBox "La feuille Année " & An2 & " existe déjà."
End Sub