Est-il possible de compléter ou de modifier la macro?

Version imprimable

Bonjour le forum,
Je ne sais si c'est possible mais ça n'a qu'une importance relative.
En effet en modifiant les années dans ligne en rouge on change l'année dans les cellules suivantes: A1 A2 A22 A40 A58 ces cellules sont fusionnées de A à F => A1:F1 A2:F2 A22:F22 A40:F40 A58:F58
Serait-il possible de faire ajouter l'année sans intervenir sur 2015 par 2016 etc.?
Compléter ou modifier la macro ci-dessous.
Merci pour vos éventuels retours.
Bien cordialement

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Option Explicit

'Macro pour modifier Année dans TOUTES les CELLULES de la Feuille Excel.Exemple => 2015 par 2016

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

  Couleur = Array(3, 4, 5, 6, 7, 8, 9, 10, 17, 40, 49, 42)
  With ActiveSheet
    An = Val(Split(.Name, " ")(1))
    If An = 0 Then
      MsgBox "Nom de la feuille non conforme"
      Exit Sub
    End If
    .Unprotect
    NomFeuille = "Charges " & An + 1 'Espace après Charges affiche Charges 2014.Supprimer Espace affiche Charges2014

    .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
  End With
  With ActiveSheet
    .Name = NomFeuille
    .Tab.ColorIndex = Couleur((An - 2000) Mod 12)
    .Range("E3:E4,A8:C11,E8:E11,A13:C16,E13:E16,A26:C29,E26:E29,A31:C34,E31:E34,A44:C47,E44:E47,A49:C52,E49:E52,A62:C65,E62:E65,A67:C70,E67:E70,F5,F23,F41,F59,G8:I11,G13:I16,G26:I29,G31:I34,G44:I47,G49:I52,G62:I65,G67:I70").ClearContents
    '.Range("E3:E4,A8:C11,E8:E11,A13:C16,E13:E16,A26:C29,E26:E29,A31:C34,E31:E34,A44:C47,E44:E47,A49:C52,E49:E52,A62:C65,E62:E65,A67:C70,E67:E70,F5,F23,F41,F59,G8:I11,G13:I16,G26:I29,G31:I34,G44:I47,G49:I52,G62:I65,G67:I70").Interior.ColorIndex = 3
    'Modifier l 'Année dans la Ligne ci-dessous
    .Cells.Replace What:="2015", Replacement:="2016", LookAt:=xlPart, _      
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("A1").Select
  End With
End Sub

29/06/2015, 13h24
Jean-Philippe André

Salut,

qu'entends tu exactement par

Citation:

Serait-il possible de faire ajouter l'année sans intervenir sur 2015 par 2016 etc.?

Tu veux qu'automatiquement ça prenne l'année en cours / année +1 ? que ca récupère l'année ailleurs dans le classeur ?

Il faut être un peu plus précis sur ton besoin stp :)

Merci
29/06/2015, 13h43
Un Internaute

Bonjour jpcheck,
Lorsque je cliques sur le bouton Nouvelle année ça ajoute la feuille Charges 2016, toutes les cellules concernées sont à blanc mais il faut il faut intervenir sur la macro 2015 par 2016 pour obtenir dans les cellules A1 A2 A22 A40 A58 2016.
je ne sais si c'est possible
Merci à toi
Bien cordialement

Voilà.
Ligne en rouge
Bonne fin de soirée à tous

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Option Explicit

'Macro pour modifier Année dans TOUTES les CELLULES de la Feuille Excel.Exemple => 2015 par 2016

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

  Couleur = Array(3, 4, 5, 6, 7, 8, 9, 10, 17, 40, 49, 42)
  With ActiveSheet
    An = Val(Split(.Name, " ")(1))
    If An = 0 Then
      MsgBox "Nom de la feuille non conforme"
      Exit Sub
    End If
    .Unprotect
    NomFeuille = "Charges " & An + 1 'Espace après Charges affiche Charges 2014.Supprimer Espace affiche Charges2014

    .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
  End With
  With ActiveSheet
    .Name = NomFeuille
    .Tab.ColorIndex = Couleur((An - 2000) Mod 12)
    .Range("E3:E4,A8:C11,E8:E11,A13:C16,E13:E16,A26:C29,E26:E29,A31:C34,E31:E34,A44:C47,E44:E47,A49:C52,E49:E52,A62:C65,E62:E65,A67:C70,E67:E70,F5,F23,F41,F59,G8:I11,G13:I16,G26:I29,G31:I34,G44:I47,G49:I52,G62:I65,G67:I70").ClearContents
    '.Range("E3:E4,A8:C11,E8:E11,A13:C16,E13:E16,A26:C29,E26:E29,A31:C34,E31:E34,A44:C47,E44:E47,A49:C52,E49:E52,A62:C65,E62:E65,A67:C70,E67:E70,F5,F23,F41,F59,G8:I11,G13:I16,G26:I29,G31:I34,G44:I47,G49:I52,G62:I65,G67:I70").Interior.ColorIndex = 3
    .Cells.Replace What:=An, Replacement:=An + 1, LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    Range("A1").Select
  End With
End Sub

Bonjour le forum,
La macro a t-elle vraiment besoin de ce bout de code en rouge?
Apparemment non.
Votre avis SVP
Merci pour vos réponses
Bonne journée à tous

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
'Macro pour modifier Année dans TOUTES les CELLULES de la Feuille Excel.Exemple => 2015 par 2016

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

  Couleur = Array(3, 4, 5, 6, 7, 8, 9, 10, 17, 40, 49, 42)
  With ActiveSheet
    An = Val(Split(.Name, " ")(1))
    If An = 0 Then
      MsgBox "Nom de la feuille non conforme"
      Exit Sub
    End If
    .Unprotect
    NomFeuille = "Charges " & An + 1 'Espace après Charges affiche Charges 2014.Supprimer Espace affiche Charges2014

    .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
  End With
  With ActiveSheet
    .Name = NomFeuille
    .Tab.ColorIndex = Couleur((An - 2000) Mod 12)
    .Range("E3:E4,A8:C11,E8:E11,A13:C16,E13:E16,A26:C29,E26:E29,A31:C34,E31:E34,A44:C47,E44:E47,A49:C52,E49:E52,A62:C65,E62:E65,A67:C70,E67:E70,F5,F23,F41,F59,G8:I11,G13:I16,G26:I29,G31:I34,G44:I47,G49:I52,G62:I65,G67:I70").ClearContents
    '.Range("E3:E4,A8:C11,E8:E11,A13:C16,E13:E16,A26:C29,E26:E29,A31:C34,E31:E34,A44:C47,E44:E47,A49:C52,E49:E52,A62:C65,E62:E65,A67:C70,E67:E70,F5,F23,F41,F59,G8:I11,G13:I16,G26:I29,G31:I34,G44:I47,G49:I52,G62:I65,G67:I70").Interior.ColorIndex = 3
    'Modifier l 'Année dans la Ligne ci-dessous
    .Cells.Replace What:=An, Replacement:=An + 1, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False    Range("A1").Select
  End With
End Sub