Code pour dupliquer feuilles avec renommation automatique

**capi81** · 16/11/2017, 09h20

Bonjour le forum

Le code ci-dessous me permet de créer de nouveaux utilisateurs.
Lorsqu'un utilisateur est crée, cela doit entrainer l'ajout de 2 feuille automatiquement avec renommation de ces nouvelles feuilles.
Voici la partie du code qui gère la création de nouvelles feuilles:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sheets("INFO").Copy after:=Sheets(3)
    On Error GoTo nomExistant
    ActiveSheet.Name = DEST
    On Error GoTo 0
    f.Activate
    '-----
    Sheets("ADMIN").Copy after:=Sheets("ADMIN")
    On Error GoTo nomExistant
    ActiveSheet.Name = "TBC" & DEST
    f.Activate
    Unload Me

Je ne sais pas mais il ne fonctionne pas comme je veux.
La feuille "INFO" est dupliquée mais il n'est pas automatiquement renommé.
La feuille "ADMIN" ne se duplique pas.
Merci de m'aider sachant que le code intégrale est le suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Private Sub CommandButton2_Click()
 
'cette macro sert à alimenter la feuille centralisation
'Sub Report_mensuel()
    Dim O As Worksheet 'déclare la variable O (Onglet)
    Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
    Dim DEST1 As Range
    Dim DEST2 As Range
    Dim DEST3 As Range
    Dim DEST4 As Range
    Dim DEST5 As Range
    Dim DEST6 As Range
    Dim DEST7 As Range
    Set O = Worksheets("PARAMETRE") 'définit l'onglet O
    Set f = ActiveSheet
 
    'définit la cellule de destination DEST (B3 si B3 est vide, sinon, la première cellule vide de la colonne B)
    Set DEST = IIf(O.Range("BM3").Value = "", O.Range("BM3"), O.Cells(Application.Rows.Count, 65).End(xlUp).Offset(1, 0))
    Set DEST1 = IIf(O.Range("BN3").Value = "", O.Range("BN3"), O.Cells(Application.Rows.Count, 66).End(xlUp).Offset(1, 0))
    Set DEST2 = IIf(O.Range("BO3").Value = "", O.Range("BO3"), O.Cells(Application.Rows.Count, 67).End(xlUp).Offset(1, 0))
    Set DEST3 = IIf(O.Range("BP3").Value = "", O.Range("BP3"), O.Cells(Application.Rows.Count, 68).End(xlUp).Offset(1, 0))
    Set DEST4 = IIf(O.Range("BQ3").Value = "", O.Range("BQ3"), O.Cells(Application.Rows.Count, 69).End(xlUp).Offset(1, 0))
    Set DEST5 = IIf(O.Range("BR3").Value = "", O.Range("BR3"), O.Cells(Application.Rows.Count, 70).End(xlUp).Offset(1, 0))
    Set DEST6 = IIf(O.Range("BS3").Value = "", O.Range("BS3"), O.Cells(Application.Rows.Count, 71).End(xlUp).Offset(1, 0))
    Set DEST7 = IIf(O.Range("BT3").Value = "", O.Range("BT3"), O.Cells(Application.Rows.Count, 72).End(xlUp).Offset(1, 0))
    DEST = Me.TextBox1 '= DEST 'copie la plage nommée "reel" dans DEST
    DEST1 = Me.TextBox2
    DEST2 = Me.ComboBox1
    DEST3 = Me.ComboBox3
    DEST4 = Me.ComboBox2
    DEST5 = Me.TextBox3
    DEST6 = Me.TextBox4
    DEST7 = Me.TextBox5
 
    Sheets("INFO").Copy after:=Sheets(3)
    On Error GoTo nomExistant
    ActiveSheet.Name = DEST
    On Error GoTo 0
    f.Activate
    '-----
    Sheets("ADMIN").Copy after:=Sheets("ADMIN")
    On Error GoTo nomExistant
    ActiveSheet.Name = "TBC" & DEST
    f.Activate
    Unload Me
Exit Sub
 
nomExistant:
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    MsgBox "Ce nom existe déjà. Choisissez-en un autre.", 16
    Exit Sub
    Resume Next
 
End Sub

**halaster08** · 16/11/2017, 10h18

Bonjour,
Je pense que ton problème vient de là

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
nomExistant:
 
    Exit Sub
    Resume Next

Si tu quitte la sub le resume next ne sert a rien, c'est soit l'un soit l'autre.

**capi81** · 16/11/2017, 10h34

Bonjour Halaster08

Merci pour votre intervention.
Dans ce cas je dois les enlever ou changer leur position.

Cordialement

**halaster08** · 16/11/2017, 11h11

Ca dépend de ce que tu veux faire, pour l'instant si le nom de la feuille existe déjà, tu supprimes la feuille active et arrête la macro
Si tu veux que la macro continue enlève le exit sub

**capi81** · 16/11/2017, 17h57

Voici le nouveau code après mes essais:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sheets("INFO").Copy after:=Sheets(3)
    On Error GoTo nomExistant
    ActiveSheet.Name = DEST
    On Error GoTo 0
    'Resume Next
    'f.Activate
    '-----
    Sheets("ADMIN").Copy after:=Sheets("ADMIN")
    On Error GoTo nomExistant
    ActiveSheet.Name = "TBC" & DEST
    f.Activate
   ' Resume Next
 
'Exit Sub
 
nomExistant:
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    MsgBox "Ce nom existe déjà. Choisissez-en un autre.", 16
    Resume Next
    'Exit Sub
    Unload Me

La macro fait le travail demandé mais je ne sais pas pourquoi cette partie du code se déclenche sans qu'aucune condition nécessitant son déclenchement se produise.
Autrement dit quand j'exécute la macro, elle crée les feuilles et les nomme et après elle affiche le msg box et supprime la feuille active.
comment corriger ce désagrément.

Cela est vrai lorsque le test se fait dans le fichier test mais dans le fichier réel il ne fonctionne pas.
certainement que cela est dû au bricolage.
Merci de m'aider

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
nomExistant:
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    MsgBox "Ce nom existe déjà. Choisissez-en un autre.", 16
    Resume Next

merci d'avance

Invité · 16/11/2017, 20h10

Bonsoir,
Je ne vois pas l'intérêt de faire une copy et lui donner un nom qui existe peut-être!

Qu'advient il de la copy?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Function IsExiste(nom as string) as boolean
For i =1 to sheets.count
If ucase(sheets(i).name) =ucase(nom) then IsExiste= true:exit function
Next
End function
Sub test()
 
If not IsExiste(DEST) then
Sheets("INFO").Copy after:=Sheets(3)
    ActiveSheet.Name = DEST
 end if
End sub

Et enlèves ces vilains on error!

**capi81** · 16/11/2017, 20h55

Bonsoir dysorthographie

Merci pour votre solution que j'ai pas encore testée.

Je ne vois pas l'intérêt de faire une copy et lui donner un nom qui existe peut-être!

En réalité il s'agit d'une solution qui permettra de pouvoir apprécier le travail de chaque commercial.
Dans le même fichier chaque commercial aura une feuille portant son code utilisateur.
La présentation de la feuille ou chaque utilisateur devra renseigner est la même pour tous les commerciaux à la différence que chaque commercial aura sa feuille qui permettra au responsable de pouvoir apprécier les réalisations individuelles.
D'ou la necessité de dupliquer la feuille "INFO" et la feuille "ADMIN" lorsqu'un profil est crée.

Qu'advient il de la copy?

C'est à partir d'une feuille (exemplaire) que les autres seront crées donc pas de soucis.
Votre solution prend t-elle en compte la duplication de la 2ème feuille "ADMIN"?
J'ai l'impression quelle se limite à la duplication de le feuille "INFO" seulement.
Espérant m'avoir fait comprendre.

Invité · 16/11/2017, 22h24

Ce que je voulais dire, c'est que tu copies ta feuille et ensuite tu la renommes et si le nom que tu veux lui donner existe déjà il y a un erreur dou le on error!
IsExiste permet de vérifier l'existence d'une feuille avant la copy!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
If not IsExiste("TBC" & DEST) then
Sheets("ADMIN").Copy after:=Sheets("ADMIN")
    ActiveSheet.Name = "TBC" & DEST
 end if

**RyuAutodidacte** · 17/11/2017, 08h47

Bonjour,

Pour ma part, je trouverais plus logique, si c'est possible bien sûr,
de créer une nomenclature incrementiel type prenant en compte l'utilisateur et la feuille et ce qui correspond au travail (dont seul le contexte vous est propre, => a réfléchir),
permettant par la suite de dupliquer les ledits feuilles sans se soucier si elles existent …

**capi81** · 17/11/2017, 19h08

Bonsoir a tous
Merci pour vos contributions.
Dysorthographie:je n'arrive pas a adapter votre code dans mon 1er code (post #1).
Comment l'intégrer dans mon code initial?
Le 1er code (Function isexiste) a été logé dans 1 module et la sub test dans la partie du code qui doit gérer la duplication et renommer les feuilles.
Je rencontre 1 débogage sur la variable "DEST".
Ryautodidacte: je partage votre idée car c'est suivant cette logique que je conçois mon outil.merci

A bientôt

Code pour dupliquer feuilles avec renommation automatique [XL-2013]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager