Compléter une macro

Bonjour le forum,
Dans la macro ci-dessous
Lorsque je vais passer à l'année suivante (2017) je voudrais que la ligne ci-desous (en rouge) soit de taille 26
.Range("G1").Characters(Start:=1, Length:=20).Font.ColorIndex = 3
Toutes les autres lignes sont de taille 16
Quelqu'un aurait-il une idée SVP?
Merci d'avance



Sub NouvelleAnnee()
Dim NomFeuille As String
Dim An As Integer
Dim Couleur
Dim Nom As String

Couleur = Array(3, 5, 43, 6, 7, 33, 29, 27, 38, 46, 26, 6)
With ActiveSheet
An = Val(Split(.Name, " ")(1))
If An = 0 Then
MsgBox "Nom de La Feuille non Conforme"
Exit Sub
End If
.Unprotect
NomFeuille = "Année " & An + 1
.Cells.Replace What:=An, Replacement:=An + 1
.Range("G1").Font.ColorIndex = 5
.Range("G1").Characters(Start:=1, Length:=20).Font.ColorIndex = 3
.Range("G1").Characters(Start:=35, Length:=6).Font.ColorIndex = 3
.Range("G1").Characters(Start:=56, Length:=5).Font.ColorIndex = 3
.Range("G1").Characters(Start:=63, Length:=16).Font.ColorIndex = 3
.Range("G1").Characters(Start:=87, Length:=15).Font.ColorIndex = 3
.Range("G1").Characters(Start:=110, Length:=14).Font.ColorIndex = 3
.Range("G1").Characters(Start:=137, Length:=15).Font.ColorIndex = 3
.Range("G1").Characters(Start:=176, Length:=10).Font.ColorIndex = 3
.Range("G1").Characters(Start:=223, Length:=16).Font.ColorIndex = 3


.Copy after:=Sheets(Sheets.Count)
'.Shapes("AnneePlus").Delete 'Mettre en commentaires pour ne pas effacer le bouton (nouvelle année)de la Feuille Précédente
.Protect
Nom = .Name
End With
With ActiveSheet
.Name = NomFeuille
.Tab.ColorIndex = Couleur((An - 2000) Mod 12)
.Range("H4:I15,E4:E15,F4:F15").ClearContents
.Cells.Replace What:=An, Replacement:=An + 1
.Cells.Replace What:=An - 1, Replacement:=An

.Range("A1").Select
End With
End Sub