Macro pour faire afficher "existe déjà"

Bonjour le forum

C'est pour lui faire dire que l'année 2023 (exemple) existe déjà

Je n'y arrive pas

Cordialement

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

  Application.ScreenUpdating = False
  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 = "Retraites " & An + 1   'Espace après Retraites affiche Retraites 2022.

    .Copy after:=Sheets(Sheets.Count)
    '.Shapes("AnneePlus").Delete
'    .Protect
  End With
  With ActiveSheet
    .Name = NomFeuille
    .Tab.ColorIndex = Couleur((An - 2000) Mod 12)
    .Range("B4:B6,B10:B12,C17,F4:F6,F10:F12,G4:G6,G10:G12").ClearContents
    '.Range("B4:B6,B10:B12,C17,F4:F6,F10:F12,G4:G6,G10:G12").Interior.ColorIndex = 8

    'Ces 2 lignes ci-dessous pour faire passer les CELLULES B3, B9, B16, A16, C16 de 2017 à 2018
     .Cells.Replace What:=An, Replacement:=An + 1     '1ère phase on augmente de 1 l'année supérieure
     .Cells.Replace What:=An - 1, Replacement:=An     '2ème phase on augmente de 1 l'année inférieure

    Call Joli(.[A1], 10, 8)
    Call Joli(.[A1], 21, 7)
    Call Joli(.[A1], 38, 5)

    Call Joli(.[A2], 6, 4)

    Call Joli(.[A7], 1, 4)

    Call Joli(.[A8], 10, 4)

    Call Joli(.[A14], 9, 7)
    Call Joli(.[A14], 26, 4)
    Call Joli(.[A14], 26, 4)
    Call Joli(.[A14], 32, 9)

    Call Joli(.[B3], 51, 4)

    Call Joli(.[B9], 51, 4)

    Call Joli(.[C3], 51, 4)

    Call Joli(.[C9], 51, 4)

    Call Joli(.[D3], 38, 4)

    Call Joli(.[D9], 38, 4)

    Call Joli(.[E3], 37, 4)

    Call Joli(.[E9], 37, 4)

    Call Joli(.[F3], 21, 4)

    Call Joli(.[F9], 21, 4)

    With .Range("C4:C6")
      .Copy
      ActiveSheet.Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
      .ClearContents
    End With

    With .Range("C10:C12")
      .Copy
      ActiveSheet.Range("B10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
      .ClearContents
    End With
    .Range("A1").Select

  End With
End Sub

bonjour,

Sub NouvelleAnnee()
     Dim NomFeuille As String, sh As Worksheet
     ....
     NomFeuille = "Retraites " & An + 1   'Espace après Retraites affiche Retraites 2022.
     On Error Resume Next 'continuer en cas d'erreur
     Set sh = Nothing
     Set sh = Sheets(NomFeuille) 'essayer à assigner une feuille avec ce nom à sh, si cela réussit, c'est que la feuille existe
     On Error GoTo 0
     If Not sh Is Nothing Then MsgBox "la feuille " & nomfeuille & " existe déjà", vbExclamation 

Bonjour BsAlv

Je vais voir ça tranquillement mais apparemment ça ne fonctionnerait pas

Là je n'ai pas le temps

Merci à toi

Cordialement

bonjour,

il faut remplacer ces "..." par les 10 lignes de code que vous aviez déjà !

Re BSAlv

Effectivement ça met bien le message sauf que ça me crée une feuille nommée

Retraites 2022 (2)

Merci à toi

Re BsAlv

J'ai trouvé ça et ça fonctionne

Merci à toi

Bien cordialement

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

  Application.ScreenUpdating = False
  Couleur = Array(3, 4, 5, 6, 7, 8, 9, 10, 17, 40, 49, 42)

  An1 = Val(Split(ActiveSheet.Name, " ")(1))

  If An1 = 0 Then MsgBox "Nom de la Feuille non Conforme": Exit Sub
    MsgBox "La feuille Année " & An1 + 1 & " existe déjà."
    Exit Sub
  ActiveSheet.Copy , Sheets(Sheets.Count): An0 = An1 - 1: An2 = An1 + 1
  With ActiveSheet                'onglet de la NOUVELLE année
    .Unprotect: .Name = "Retraites " & An2
    .Tab.ColorIndex = Couleur((An2 - 2000) Mod 12)
  End With

    '.Shapes("AnneePlus").Delete          'Mettre en commentaires pour ne pas effacer le bouton (nouvelle année)de la Feuille Précédente
'    .Protect
  With ActiveSheet
    .Name = NomFeuille
    .Tab.ColorIndex = Couleur((An - 2000) Mod 12)
    .Range("B4:B6,B10:B12,C17,F4:F6,F10:F12,G4:G6,G10:G12").ClearContents
    '.Range("B4:B6,B10:B12,C17,F4:F6,F10:F12,G4:G6,G10:G12").Interior.ColorIndex = 8

    'Ces 2 lignes ci-dessous pour faire passer les CELLULES B3, B9, B16, A16, C16 de 2017 à 2018
     .Cells.Replace What:=An, Replacement:=An + 1     '1ère phase on augmente de 1 l'année supérieure
     .Cells.Replace What:=An - 1, Replacement:=An     '2ème phase on augmente de 1 l'année inférieure

    Call Joli(.[A1], 10, 8)
    Call Joli(.[A1], 21, 7)
    Call Joli(.[A1], 38, 5)

    Call Joli(.[A2], 6, 4)

    Call Joli(.[A7], 1, 4)

    Call Joli(.[A8], 10, 4)

    Call Joli(.[A14], 9, 7)
    Call Joli(.[A14], 26, 4)
    Call Joli(.[A14], 26, 4)
    Call Joli(.[A14], 32, 9)

    Call Joli(.[B3], 51, 4)

    Call Joli(.[B9], 51, 4)

    Call Joli(.[C3], 51, 4)

    Call Joli(.[C9], 51, 4)

    Call Joli(.[D3], 38, 4)

    Call Joli(.[D9], 38, 4)

    Call Joli(.[E3], 37, 4)

    Call Joli(.[E9], 37, 4)

    Call Joli(.[F3], 21, 4)

    Call Joli(.[F9], 21, 4)

    With .Range("C4:C6")
      .Copy
      ActiveSheet.Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
      .ClearContents
    End With

    With .Range("C10:C12")
      .Copy
      ActiveSheet.Range("B10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
      .ClearContents
    End With
    .Range("A1").Select

  End With
End Sub

moi, je pensais plutôt à ceci

Sub NouvelleAnnee()
     Dim NomFeuille As String
     Dim An    As Integer
     Dim Couleur
     Dim Sh    As Shape
     Dim sht   As Worksheet

     Application.ScreenUpdating = False
     Couleur = Array(3, 4, 5, 6, 7, 8, 9, 10, 17, 40, 49, 42)

     On Error Resume Next 'ne pas arrêter à cause d'une erreur
     sp = Split(ActiveSheet.Name)
     If UBound(sp) <> 1 Then MsgBox "le nom de la feuille ne contient pas exactement 2 mots": Exit Sub
     If Not IsNumeric(sp(1)) Then MsgBox "2ième mot n'est pas numérique": Exit Sub
     NomFeuille = "Retraite " & Format(sp(1) + 1, "00")
     Set sht = Sheets(NomFeuille)
     If Not sht Is Nothing Then MsgBox "la feuille " & NomFeuille & " existe déjà": Exit Sub
     On Error GoTo 0

     ....
End Sub

Bonjour BsAlv

Oui ce que j'ai fait ne fonctionne pas car je n'ai pas été au bout...

Peux-tu stp mettre la macro en entier car on ne s'en sortira pas.

Je m'excuse pour le dérangement

Bien cordialement à toi

bonjour,

Option Compare Text     'majuscules et miniscules egal dans ce module !!! PREMIERE LIGNE DU MODULE

Sub NouvelleAnnee()
     Dim NomFeuille As String, Nom, An0, An_P1, An_M1, sht As Worksheet
     Dim Couleur: Couleur = Array(3, 4, 5, 6, 7, 8, 9, 10, 17, 40, 49, 42)

       Application.ScreenUpdating = False

     Nom = ActiveSheet.Name
     If Not Nom Like "Retraites ####" Then     ' verifier si la feuille actuelle est nommée comme "Retraites xxxx"
          MsgBox "Le nom de la feuille active n'est pas comme ""Retraites aaaa""" & vbLf & "Désolé", vbInformation, "Fin de la macro"

     Else
          An0 = Right(Nom, 4) 'cette année
          An_P1 = Format(An0 + 1, "0000") 'prochaine année
          An_M1 = Format(An0 - 1, "0000") 'année précédente
          NomFeuille = "Retraites " & An_P1
          On Error Resume Next     'ne pas arrêter à cause d'une erreur
          Set sht = Nothing: Set sht = Sheets(NomFeuille)
          On Error GoTo 0
          If Not sht Is Nothing Then
               MsgBox "la feuille """ & NomFeuille & """ existe déjà" & vbLf & "aucune copie n'a été faite", vbInformation, "Fin de la macro"
          Else

               ActiveSheet.Copy after:=Sheets(Sheets.Count)
               With ActiveSheet
                    .Name = NomFeuille
     '  Shapes("AnneePlus").Delete
     '    .Protect
                    .Tab.ColorIndex = Couleur(An_P1 Mod UBound(Couleur))
                    .Range("B4:B6,B10:B12,C17,F4:F6,F10:F12,G4:G6,G10:G12").ClearContents
     '.Range("B4:B6,B10:B12,C17,F4:F6,F10:F12,G4:G6,G10:G12").Interior.ColorIndex = 8

     'Ces 2 lignes ci-dessous pour faire passer les CELLULES B3, B9, B16, A16, C16 de 2017 à 2018
                    .Cells.Replace What:=An0, Replacement:=An_P1     '1ère phase on augmente de 1 l'année supérieure
                    .Cells.Replace What:=An_M1, Replacement:=An0  '2ème phase on augmente de 1 l'année inférieure

                    Call joli(.[A1], 10, 8)
                    Call joli(.[A1], 21, 7)
                    Call joli(.[A1], 38, 5)

                    Call joli(.[A2], 6, 4)

                    Call joli(.[A7], 1, 4)

                    Call joli(.[A8], 10, 4)

                    Call joli(.[A14], 9, 7)
                    Call joli(.[A14], 26, 4)
                    Call joli(.[A14], 26, 4)
                    Call joli(.[A14], 32, 9)

                    Call joli(.[B3], 51, 4)

                    Call joli(.[B9], 51, 4)

                    Call joli(.[C3], 51, 4)

                    Call joli(.[C9], 51, 4)

                    Call joli(.[D3], 38, 4)

                    Call joli(.[D9], 38, 4)

                    Call joli(.[E3], 37, 4)

                    Call joli(.[E9], 37, 4)

                    Call joli(.[F3], 21, 4)

                    Call joli(.[F9], 21, 4)

                    With .Range("C4:C6")
                         .Copy
                         ActiveSheet.Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                         .ClearContents
                    End With

                    With .Range("C10:C12")
                         .Copy
                         ActiveSheet.Range("B10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                         .ClearContents
                    End With
                    .Range("A1").Select
               End With
          End If
     End If
End Sub

Sub joli(x1, x2, x3)
     'macro inconnue
End Sub

Bonjour BsAlv

Excuse moi pour le retard à répondre mais Nickel

Cette fois ci on y est

Encore merci à toi pour ton implication

Bonne fin de WE

Cordialement