Discussion :

[JordanA36]

Bonjour à tous,

Je vais essayer de vous expliquer correctement mon problème, qui je pense n'est pas nouveau... Cependant je n'ai pas trouvé sur le forum la discussion nécessaire à ma solution donc je vous pose le problème:

Avec VBA Je voudrais dupliquer ma feuille Excel, et en même temps la renommer de cette façon :
mes feuilles principales sont notées avril18/mai18/juin18..
Ce que je voudrais c'est mettre en place une macro permettant de copier coller et renommer en : en juillet18/Aout18/ etc..
Voici le code que j'ai mis à contribution :

Code :

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

1
2
3
4
5
6
7
8
9
Dim Cpt As Byte
For Cpt = 18 To 18
  With ActiveWorkbook.ActiveSheet
    .Copy After:=Worksheets(Worksheets.Count)
  End With
ActiveSheet.Name = "Juillet " & Cpt
Next Cpt
 
End Sub

Le code me permet de dupliquer ma feuille de juin18 et la renommer en juillet18, cependant je pense que la mise en place d'une boucle est nécessaire..
Pourriez-vous m'aider svp ?

[Menhir]

Où doit être récupérée la date servant de référence au nom d'onglet ?
Si c'est dans le nom de la feuille modèle, ça va être compliqué et peu fiable étant donné le format (textuel) choisi.

Ne serait-il pas possible de prendre comme format quelque chose comme mm-aa ?
Par exemple, remplacer "Juillet18" par "07-18".

[JordanA36]

Bonjour Menhir,

Oui en effet je pense que rester dans cette condition me semble peu fiable et je n'est pas beaucoup de temps.
Finalement je vais opter pour la solution plus basique.

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
Sub dupliquer_feuille()
'
' dupliquer_feuille Macro
'
If MsgBox("Souhaitez-vous duppliquer la feuille?", vbYesNo) = vbNo Then Exit Sub
    If vbYes Then
    End If
Dim Cpt As Byte
 
For Cpt = 18 To 18
  With ActiveWorkbook.ActiveSheet
    .Copy After:=Worksheets(Worksheets.Count)
  End With
With ActiveSheet.Name = "07-2018" & Cpt
End With
Next Cpt
 
End Sub

Il me permet de dupliquer ma feuille avec l'intégralité des données à l’exception que je dois simplement renommer ma feuille.
Au final cette macro me convient du fait que je dois l'utiliser qu'une fois par mois.

Je vous souhaite une bonne journée

[Menhir]

Au final cette macro me convient du fait que je dois l'utiliser qu'une fois par mois.

Si elle te convient telle qu'elle est, je ne vois pas trop son utilité, vu que le temps pour la modifier sera à peu près équivalent à celui pour faire l'opération à la main.
Même s'il y a un gain de quelques secondes par mois, le temps que tu as passé à écrire la macro va être long à rentabiliser.

Je te refais quand même ta macro en mieux.
Je l'ai tapée à l'arrache, directement sur le forum. Il se peut donc que tu ais du débugage à faire mais les éléments sont là.

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
Sub dupliquer_feuille()
Dim Cpt As Long, N As Long, Rep As Variant, Nom As String
 
Rep = Application.InputBox(Prompt:="Combien de copies de " & ActiveSheet.Name & "souhaitez-vous créer ?", Title:="Question", Default:=1, Type:=1)
If Not Rep Then Exit Sub
If Rep = 0 Then Exit Sub
N = Rep
 
For Cpt = 1 To N
   Nom = ActiveSheet.Name
   ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
   ActiveSheet.Name = Format(DateSerial(Val(Right(Nom, 4)), Val(Left(Nom, 2)) + 1, 1), "mm-yyyy")
Next Cpt
 
End Sub

[patricktoulon]

re

Code :

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

1
2
3
4
Sub test()
    newname = newMonTh("mai 2018")
    MsgBox newname
End Sub

Code :

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

1
2
3
4
5
6
7
8
Function newMonTh(nom)
    Dim M
    M = Mid(nom, 1, 4)
    x = Switch(M Like "*janv*", 1, M Like "*fevr*", 2, M Like "*mars*", 3, M Like "*avri*", 4, M Like "*mai*", 5, _
             M Like "*juin*", 6, M Like "*juil*", 7, M Like "*aout", 8, M Like "*sept*", 9, M Like "*octo*", 10, _
             M Like "*nove*", 11, M Like "*dece*", 12)
    newMonTh = Format(DateSerial(Right(nom, 4), x + 1, 1), "mmmm yyyy")
End Function