Copier/Coller/Renommer feuille en VBA selon messagebox

[micapilote]

Bonjour, je débute en VBA et je ne vais pas tarder à acheter un bouquin pour m'aider mais en attendant, si vous pouviez m'aider.
J'ai 1 fichier avec 2 feuilles modèles
je souhaiterai a l'ouverture du fichier que dans un premier temps, il me demande "nouveau fichier" ou "consultation",
"consultation" ouvrirai le fichier tel quel
et "nouveau fichier" afficherai ensuite un message et me demande quel est le nom du client, et que la macro copier/colle mes 2 modèles en les renommant avec le nom du client et inscrive aussi le nom dans les 2 cellules indiquée (les jaunes)

Comment ça j'en demande beaucoup !
Merci d'avance

PS: des idées de sites, livres, autres pour débuter en VBA ?

 

[micapilote]

Re : Copier/Coller/Renommer feuille en VBA selon messagebox

Après une petite recherche (tardive désolé)
j'ai trouvé ça
je bosse la dessus en attendant

 

[pierrejean]

Re : Copier/Coller/Renommer feuille en VBA selon messagebox

Bonjour micapilote

Vois si cela te convient

 

[micapilote]

Re : Copier/Coller/Renommer feuille en VBA selon messagebox

Merci ça m'aide bcp, on y est presque, j'ai modifié une chose, il faut copier coller les modèles et non les renommer direct donc j'ai rajouté ça

Private Sub Workbook_Open()
x = MsgBox("Nouveau Fichier", vbYesNo)
If x = 6 Then
nom = InputBox("Nom du client")
Sheets("Modèle1").Copy After:=Sheets(1)
Sheets("Modèle1").Range("B2") = nom
Sheets("Modèle2").Copy After:=Sheets(1)
Sheets("Modèle2").Range("B3") = nom
Sheets("Modèle1").Name = nom & "1"
Sheets("Modèle2").Name = nom & "2"
End If
End Sub

La seule chose que je n'arrive pas (pour le moment), c'est éviter que mes feuilles modèle soit renommer (modèle1 devient modèle1(2)
Merci

 

[pierrejean]

Re : Copier/Coller/Renommer feuille en VBA selon messagebox

Re

OK
teste ceci

Private Sub Workbook_Open()
x = MsgBox("Nouveau Fichier", vbYesNo)
If x = 6 Then
 nom = InputBox("Nom du client")
 Sheets("Modèle1").Copy after:=Sheets(Sheets.Count)
 ActiveSheet.Range("B2") = nom
 ActiveSheet.Name = nom & "1"
 Sheets("Modèle2").Copy after:=Sheets(Sheets.Count)
 ActiveSheet.Range("B3") = nom
 ActiveSheet.Name = nom & "2"
End If
End Sub

 

[micapilote]

Re : Copier/Coller/Renommer feuille en VBA selon messagebox

A priori c'est niquel. 2 (petites) choses
comment renvoyer les 2 nouvelles feuilles en 1er et 2eme position
et est t'il possible de renommer une feuille avec une variable (la c'est bon) et un autre mot ?
pour le moment ça donne
Modèle devient "toto" et je voudrais que cela devienne "Facture toto"
merci beaucoup en tout cas.

 

[micapilote]

Re : Copier/Coller/Renommer feuille en VBA selon messagebox

c'est bon, j'ai trouvé pour le nom

ActiveSheet.Name = nom & "Ecrire ici"

ou

ActiveSheet.Name = "Ecrire ici" & nom

et pour la position, je me suis débrouillé autrement .

 

[micapilote]

Re : Copier/Coller/Renommer feuille en VBA selon messagebox

Voilà, on touche (presque) au but

Private Sub Workbook_Open()
x = MsgBox("Voulez vous créer une nouvelle feuille ?", vbYesNo)
If x = 6 Then
nom = InputBox("Quel est le nom du client ?")
Sheets("Modèle1").Copy before:=Sheets("Modèle1")
ActiveSheet.Range("B2") = nom
ActiveSheet.Name = nom & " (FS)"
Sheets("Modèle2").Copy before:=Sheets("Modèle1")
ActiveSheet.Range("B3") = nom
ActiveSheet.Name = nom & " (Facture)"
End If
End Sub

Maintenant, j'essaye de faire répéter une 2nde question autant de fois que l'on ne répond pas non a la question.J'en suis là:

Private Sub Workbook_Open()
x = MsgBox("Voulez vous créer une nouvelle feuille ?", vbYesNo)
If x = 6 Then
nom = InputBox("Quel est le nom du client ?")
Sheets("Modèle1").Copy before:=Sheets("Modèle1")
ActiveSheet.Range("B2") = nom
ActiveSheet.Name = nom & " (FS)"
Sheets("Modèle2").Copy before:=Sheets("Modèle1")
ActiveSheet.Range("B3") = nom
ActiveSheet.Name = nom & " (Facture)"
End If
End Sub
x = MsgBox("Voulez vous créer une autre feuille ?", vbYesNo)

en copiant collant le code, ça fonctionne mais ça ne s'arrête pas (genre 10 copier/coller de code et j'ai 10X la question) alors que si on répond "non" à la 2eme question je voudrais que la cela s'arrête.

 

[pierrejean]

Re : Copier/Coller/Renommer feuille en VBA selon messagebox

Re

Inspire-toi de ceci

Private Sub Workbook_Open()
For n = 1 To 100 '100= maximum de copies (si plus envisagées augmenter)
x = MsgBox("Nouveau Fichier", vbYesNo)
If x = 6 Then
 nom = InputBox("Nom du client")
 Sheets("Modèle1").Copy after:=Sheets(Sheets.Count)
 ActiveSheet.Range("B2") = nom
 ActiveSheet.Name = nom & "1"
 Sheets("Modèle2").Copy after:=Sheets(Sheets.Count)
 ActiveSheet.Range("B3") = nom
 ActiveSheet.Name = nom & "2"
Else
Exit Sub
End If
Next n
End Sub

 

[micapilote]

Re : Copier/Coller/Renommer feuille en VBA selon messagebox

Merci beaucoup pierrejean, j'ai adapté avec ma feuille et c'est au poil !

 

[micapilote]

Re : Copier/Coller/Renommer feuille en VBA selon messagebox

Re,
finalement gros pb avec mon fichier, j'ai omis de signaler que les 2 feuilles copiées/collées/renommées sont liées entre elles par des formules !
en gros, tout est bon mais les formules entre ces 2 feuilles ne suivent pas, chaque formule de chaque feuille reste basé sur le modèle et non la feuille copiée donc gros pb.
exemple ci joint pour mieux comprendre
j'ai juste écrit une formule toute bête en A1

 

[micapilote]

Re : Copier/Coller/Renommer feuille en VBA selon messagebox

c'est bon, trouvé, pour infos il faut copier/coller les 2 feuilles en même temps.

Private Sub Workbook_Open()
For n = 1 To 100 '100= maximum de copies (si plus envisagées augmenter)
x = MsgBox("Voulez vous créer une nouvelle facture ?", vbYesNo)
If x = 6 Then
Do
nom = InputBox("Quel est le nom du client ?")
 If nom = "" Then Exit Sub
  On Error Resume Next
  Set sht = Sheets(nom & " (FS)")
  If Err <> 0 Then
 
Sheets(Array("Facture modèle", "Détails modèle")).Copy Before:=Sheets("test")
 ActiveSheet.Name = nom & " (FS)"
Sheets(ActiveSheet.Index + 1).Name = nom & " (Détails)"
Err.Clear: Exit Do
  Else
  MsgBox "Une facture de ce nom existe déjà !"
  End If
 Loop
Else
Exit Sub
End If
Next n
End Sub