[VBA] Renommé Feuille

Résolu
Bonjour,

J'expose mon problème.

J'ai créée une macro :

Sub Badge()
Dim i, z
z = InputBox("Nombre de copies ", "Copie")
For i = 1 To z
Sheets("Nom de l'entreprise").Copy After:=Sheets(i)
ActiveSheet.Name = " Nom de l'entreprise " & i
Next i
End Sub

Jusque la pas de problème.

En effet, cette macro permet de créer un calque d'une feuille principale.

Dans ma nouvelle feuille, j'aimerai après avoir saisi dans la cellule "D17" un texte, (ex : Entreprise TEST) que la feuille se renomme par rapport au nom que j'ai saisi dans la cellule D17.

Merci bien et bonne journée

8 réponses

  1. Modérateur
    Alors il te faut :
    1- ajouter au module de ta feuille "Nom de l'entreprise" :
    Clic droit sur l'onglet de la feuille / Visualiser le code puis copier-coller ce code :
    '!! A ADAPTER le nom exact de la feuille "Nom de l'entreprise" sans oublier les
    ' espaces s'il y en a...
    Private Sub Worksheet_Change(ByVal Target As Range)
    If ActiveSheet.Name = "Nom de l'entreprise" Then Exit Sub 'ici A ADAPTER
    If Target.Address <> "$D$17" Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If FeuilleExiste(ThisWorkbook, Target.Value) Then
        MsgBox "la feuille " & Target.Value & " existe déjà"
        Target.Value = ""
        Target.Select
        Exit Sub
    Else
        ActiveSheet.Name = Target.Value
    End If
    End Sub

    2- ton code dans un module standard devient donc :
    Sub Badge()
    Dim i As Integer, z As Integer
    Application.ScreenUpdating = False
    z = InputBox("Nombre de copies ", "Copie")
    For i = 1 To z
        Sheets("Nom de l'entreprise").Copy After:=Sheets(i)
        ActiveSheet.Name = "Nom de l'entreprise " & i
    Next i
    Application.ScreenUpdating = True
    End Sub

    3- Dans le même module, sous la sub badge, ajouter la fonction :
    'sources : https://www.developpez.net/forums/d269391/logiciels/microsoft-office/excel/macros-vba-excel/vba-e-feuille-existe/
    Function FeuilleExiste(wk As Workbook, stFeuille) As Boolean
     On Error Resume Next
     FeuilleExiste = Not (wk.Sheets(stFeuille) Is Nothing)
    End Function
    1
    1. bonjour,

      Sub Badge()
      Dim i, z
      z = InputBox("Nombre de copies ", "Copie")
      For i = 1 To z
      Sheets("Nom de l'entreprise").Copy After:=Sheets(i)
      ActiveSheet.Name = " Nom de l'entreprise " & sheets("Nom de l'entreprise").range("D17")
      Next i
      End Sub
      0
      1. Bonjour,

        La macro ne fonctionne pas. Le nom de la feuille ne se modifie pas.
        0
        1. bizarre, car pour moi ca marche, as-tu mis une valeur dans la feuille Nom de l'entreprise, cellule d17??
          0
        2. Attend, je t'envoie mon fichier
          0
      2. Modérateur
        Bonjour,
        Dans ma nouvelle feuille, j'aimerai après avoir saisi dans la cellule "D17" un texte,......,que la feuille se renomme tu veux donc :
        1- créer x feuilles avec ta macro
        2- les renommer juste en écrivant un "mot", "expression" en D17 de chaque nouvelle feuille.
        J'ai bien compris?
        0
        1. C'est tout a fait ça ;)
          0
          1. Modérateur
            Alors je te laisse encore des choix... :

            1- Tu veux que la macro te demande, à chaque création de page, par Inputbox, le nom de la page?

            2- qu'une procédure automatique se lance à chaque fois que tu changeras, ultérieurement, et systématiquement, le contenu de la cellule D17 de chaque feuille?
            0
        2. 2- Exactement ce que je veux.
          0
          1. Malheureusement je n'arrive pas a faire le fonctionner. Je viens donc d'envoyer le fichier a ton adresse e-mail.

            Tu verras en case B3 que c'est la que je veux référencer le "Nom de l'entreprise" (au lieu de D17).

            J'ai pourtant modifié le code mais rien n'y fait j'ai une erreur "SUB".

            Si tu peux jeter un oeil pour voir quel est le problème au juste.

            Merci pour tous. Un grand merci
            0
            1. Un très grand merci à toi pijaku.

              Tu as vraiment fait du très bon travail. Je te remercie et a très bientôt sur CCM
              0
              1. Modérateur
                de rien.
                A bientôt
                0