Création et renommer une feuil automatiquement

[vinc24]

Bonjour

Je voudrais que les feuil se renomme ou se créent en fonction des valeurs qui se situent sur la première feuil.

colonne a j'ai une liste de nom (actuellement 4), j'aimerais que ca crée si j'en met un 5em, que ca renomme si je change les 4 premier, et que ca supprime la 4em ou 3em... si je supprime les noms.


cordialement

vincent

 

[Odesta]

Re : Création et renommer une feuil automatiquement

Bonjour et bienvenue par ici

Pour résoudre votre problème, il faut travailler par macro VBA.

Je vous invite donc à rechercher comment faire pour :

- Lancer un évènement lors de la modification de la feuille.
- Créer une feuille (commande ADD)
- Renommer la feuille créée.

Les points ainsi indépendant permettent de faciliter la recherche de la solution, qui se trouve forcement quelque part sur ce site !

Cordialement
Olivier

 

[youky(BJ)]

Re : Création et renommer une feuil automatiquement

Bonjour,
Voici un fichier exemple
Code en worksheet_change
Bruno

 

[vinc24]

Re : Création et renommer une feuil automatiquement

bonjour

Merci pour ce fichier, il fonctionne bien.
Cependant, un petit problème se pose lorsque je change le premier nom (cela supprime la feuil dans laquelle se trouve les noms.
Serait-il possible d'avoir par exemple tous les noms (que l'on peut changer) dans la colonne I (commencent pas I1)?

Cordialement

Vincent

 

[youky(BJ)]

Re : Création et renommer une feuil automatiquement

Re,
Dans ce fichier j'ai mis "toto" donc les pages qui commencent par toto ne sont pas concernées.
Bruno

 

[vinc24]

Re : Création et renommer une feuil automatiquement

quand j'ajoute ton code a un autre que j'ai déja, il me met un message d'erreur :
"Nom ambigu détecté"

Private Sub Worksheet_Change(ByVal Target As Range)
Application.DisplayAlerts = False
If Target.Column > 9 Then Exit Sub
For Each sh In Worksheets
If Application.CountIf(Range("I1", [I65536].End(3)), sh.Name) = 0 Then
If Left(sh.Name, 4) <> ">" Then sh.Delete
End If
Next
'If Left(sh.Name, 5) = "Feuil" Then Exit Sub
Application.DisplayAlerts = True
For Each c In Range("I1", [I65000].End(3))
On Error Resume Next
Z = Sheets(c.Value).[I1]
If Err > 0 And c.Value <> "" Then Worksheets.Add after:=Worksheets(Worksheets.Count): ActiveSheet.Name = c.Value
Next
Sheets(1).Select
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A2")) Is Nothing Then
    Range("A2").Copy Range("E65000").End(xlUp)(2)
   '--- tri ---
  Range("e1:e" & [e65000].End(xlUp).Row).Sort Key1:=Range("e1"), Order1:=xlAscending, _
    Header:=xlNo, OrderCustom:=1, MatchCase:=False
    '--- efface A2 ---
   Application.EnableEvents = False
    Range("A2").ClearContents
    Application.EnableEvents = True
End If
End Sub

je pense que l'erreur viens de "Private Sub Worksheet_Change(ByVal Target As Range)"
mais je ne sait pas comment régler ce problème!

Est-ce possible au lieu de créer une feuille, plutôt de faire une copie d'une feuille existante que j'ai appeler ">tableau", mais qui pourrait être appeler "toto2" pour suivre ton exemple.

merci d'avance.

vincent

 

[youky(BJ)]

Re : Création et renommer une feuil automatiquement

Bonjour,
Ta macro en un seul événement, j'ai mis 1 en rouge qui indique le nombre de caracteres.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A2")) Is Nothing Then
    Range("A2").Copy Range("E65000").End(xlUp)(2)
   '--- tri ---
  Range("e1:e" & [e65000].End(xlUp).Row).Sort Key1:=Range("e1"), Order1:=xlAscending, _
    Header:=xlNo, OrderCustom:=1, MatchCase:=False
    '--- efface A2 ---
   Application.EnableEvents = False
    Range("A2").ClearContents
    Application.EnableEvents = True
End If
Application.DisplayAlerts = False
If Target.Column > 9 Then Exit Sub
For Each sh In Worksheets
If Application.CountIf(Range("I1", [I65536].End(3)), sh.Name) = 0 Then
If Left(sh.Name, [COLOR="Red"][B]1[/B][/COLOR]) <> ">" Then sh.Delete
End If
Next
'If Left(sh.Name, 5) = "Feuil" Then Exit Sub
Application.DisplayAlerts = True
For Each c In Range("I1", [I65000].End(3))
On Error Resume Next
Z = Sheets(c.Value).[I1]
If Err > 0 And c.Value <> "" Then Worksheets.Add after:=Worksheets(Worksheets.Count): ActiveSheet.Name = c.Value
Next
Sheets(1).Select

End Sub

 

[vinc24]

Re : Création et renommer une feuil automatiquement

Bonsoir

Merci encore de votre aide.

Hier soir, j'ai éditer mon message, peut être aurais je du créer un nouveau message pour plus de clarté.

Est-ce possible au lieu de créer une feuille, plutôt de faire une copie d'une feuille existante que j'ai appeler ">tableau", mais qui pourrait être appeler "toto2" pour suivre ton exemple.

Cordialement

vincent

 

[vinc24]

Re : Création et renommer une feuil automatiquement

J'ai réussi à copier le tableau référence sur chaque nouvelle feuille. A la fin du code j'ai ajouter :

 ' Selection et copy de la feuille référence
  ThisWorkbook.Worksheets(">Table").Range("A1:AG16").Copy
    Sheets(Sheets.Count).Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Merci youky(BJ) pour ton aide

vincent