Duplication d'onglet dynamique
Bonjour à tous
Je suis actuellement en train de travailler sur un fichier dans lequel je dois écrire une macro permettant de créer un nouvel onglet sur la demande de l'utilisateur.
J'en ai fais une mais elle n'est pas du tout optimisée et par conséquent, je me retrouve complètement bloqué.
Le fonctionnement est assez simple et doit fonctionner comme ceci :
Le fichier comporte un onglet intitulé "JANVIER".
Il comprend des liens qui renvoient vers un fichier "CMS_JANVIER_2015" ainsi qu'un bouton "CREER LE MOIS SUIVANT".
Ce bouton doit donc créer l'onglet FEVRIER et faire un rechercher_remplacer de "JANVIER_2015" en "FEVRIER_2015".
Ensuite l'onglet FEVRIER, le bouton "CREER LE MOIS SUIVANT" permettra de duplquer la feuille en "MARS" et fera la même opération au niveau des liens.
Là je bloque c'est la macro. Celle que j'ai fais n'est pas dynamique, ce qui fait que le bouton que j'ai fais renvoie toujours au mois de FEVRIER.
voici l'horreur que j'ai pondu.
La grosse limitation de cette macro, c'est que pour qu'elle fonctionne il faudrait que je crée sur le premier onglet autant de bouton qu'il y a de mois, ce qui est vraiment moche et nul en fait.
Sub FEVRIER()
Sheets("JANVIER").Select
Sheets("JANVIER").Copy After:=Sheets(1)
ActiveSheet.Name = "FEVRIER"
'Macro pour rechercher remplacer
Cells.Replace What:="JANVIER_2015", Replacement:="FEVRIER_2015", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Sub MARS()
Sheets("JANVIER").Select
Sheets("JANVIER").Copy After:=Sheets(2)
ActiveSheet.Name = "MARS"
'Macro pour rechercher remplacer
Cells.Replace What:="JANVIER_2015", Replacement:="MARS_2015", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Sub AVRIL()
Sheets("JANVIER").Select
Sheets("JANVIER").Copy After:=Sheets(3)
ActiveSheet.Name = "AVRIL"
'Macro pour rechercher remplacer
Cells.Replace What:="JANVIER_2015", Replacement:="AVRIL_2015", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Sub MAI()
Sheets("JANVIER").Select
Sheets("JANVIER").Copy After:=Sheets(4)
ActiveSheet.Name = "MAI"
'Macro pour rechercher remplacer
Cells.Replace What:="JANVIER_2015", Replacement:="MAI_2015", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Sub JUIN()
Sheets("JANVIER").Select
Sheets("JANVIER").Copy After:=Sheets(5)
ActiveSheet.Name = "JUIN"
'Macro pour rechercher remplacer
Cells.Replace What:="JANVIER_2015", Replacement:="JUIN_2015", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Sub JUILLET()
Sheets("JANVIER").Select
Sheets("JANVIER").Copy After:=Sheets(6)
ActiveSheet.Name = "JUILLET"
'Macro pour rechercher remplacer
Cells.Replace What:="JANVIER_2015", Replacement:="JUILLET_2015", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Sub AOUT()
Sheets("JANVIER").Select
Sheets("JANVIER").Copy After:=Sheets(7)
ActiveSheet.Name = "AOUT"
'Macro pour rechercher remplacer
Cells.Replace What:="JANVIER_2015", Replacement:="AOUT_2015", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Sub SEPTEMBRE()
Sheets("JANVIER").Select
Sheets("JANVIER").Copy After:=Sheets(8)
ActiveSheet.Name = "SEPTEMBRE"
'Macro pour rechercher remplacer
Cells.Replace What:="JANVIER_2015", Replacement:="SEPTEMBRE_2015", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Sub OCTOBRE()
Sheets("JANVIER").Select
Sheets("JANVIER").Copy After:=Sheets(9)
ActiveSheet.Name = "OCTOBRE"
'Macro pour rechercher remplacer
Cells.Replace What:="JANVIER_2015", Replacement:="OCTOBRE_2015", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Sub NOVEMBRE()
Sheets("JANVIER").Select
Sheets("JANVIER").Copy After:=Sheets(10)
ActiveSheet.Name = "NOVEMBRE"
'Macro pour rechercher remplacer
Cells.Replace What:="JANVIER_2015", Replacement:="NOVEMBRE_2015", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Sub DECEMBRE()
Sheets("JANVIER").Select
Sheets("JANVIER").Copy After:=Sheets(11)
ActiveSheet.Name = "DECEMBRE"
'Macro pour rechercher remplacer
Cells.Replace What:="JANVIER_2015", Replacement:="DECEMBRE_2015", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Sub Macro4()
'
' Macro4 Macro
'
'
Cells.Replace What:="JANVIER_2015", Replacement:="FEVRIER_2015", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Est ce que vous pouvez me filer un coup de main là dessus ?
Je vous remercie BEAUCOUP par avance !!!
Bonjour,
Tu colle ce code dans un module standard :
Sub NouvelleFeuille()
Dim AcienMois As String
Dim NouveauMois As String
Dim Fe As Worksheet
If ActiveSheet.Name = "DECEMBRE" Then
MsgBox "Tous les mois de cette année ont été créés !"
Exit Sub
End If
NouveauMois = NomMois(ActiveSheet.Name)
If Existe(NouveauMois) = True Then
MsgBox "Le mois suivant existe déjà !"
Exit Sub
End If
AcienMois = ActiveSheet.Name
'la feuille est mise à la suite de la dernière
ActiveSheet.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = NouveauMois
ActiveSheet.Cells.Replace AcienMois & "_" & Year(Date), NouveauMois & "_" & Year(Date)
End Sub
Function NomMois(NomFeuille As String) As String
Dim TblMois()
Dim I As Integer
TblMois = Array("JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE")
For I = 0 To UBound(TblMois)
If NomFeuille = TblMois(I) Then
NomMois = TblMois(I + 1)
Exit For
End If
Next I
End Function
Function Existe(NomFeuille As String) As Boolean
Dim Fe As Worksheet
For Each Fe In Worksheets
If Fe.Name = NomFeuille Then
Existe = True
Exit For
End If
Next Fe
End Function
Sur la feuille "JANVIER" tu colle un bouton issu de la barre d'outils "Formulaire" et tu lui affecte la macro "NouvelleFeuille". La copie de la feuille va entraîner la copie du bouton avec l'affectation de la même macro donc, à chaque clic sur le bouton de la dernière feuille, ça va créer la feuille suivante à la condition qu'elle n'existe pas déjà et que la feuille active ne soit pas le mois de décembre.
Bonjour,
Autre proposition :
Sub MoisSuivant()
Dim mois, nom$, a%, i%, m%
mois = Split("JANVIER FEVRIER MARS AVRIL MAI JUIN JUILLET AOUT SEPTEMBRE OCTOBRE NOVEMBRE DECEMBRE")
With ActiveSheet
a = .Range("C9").Value
nom = .Range("C8").Value
.Name = nom & "_" & Format(a Mod 100, "00")
For i = 0 To 11
If nom = mois(i) Then
m = (i + 1) Mod 12
Exit For
End If
Next i
If m = 0 Then a = a + 1
nom = mois(m)
.Copy before:=Worksheets(1)
.Visible = False
End With
With Worksheets(1)
.Name = nom
.Range("C9").Value = a
.Range("C8").Value = nom
.Range("C6").Value = nom & "_" & a
End With
End Sub
La macro extrapole un peu sur ta demande. Elle poursuit la génération du mois suivant sur les années suivantes (et rebaptise le mois antérieur pour éviter les doublons avant de le masquer pour éviter l'encombrement, on peut éventuellement la détruire si elle ne sert plus).
Cordialement
SUPER !!!
Je test ça dès jeudi matin au bureau ! Je vais les décortiquer pour comprendre comment ça se goupille, j'ai tenter de faire des mix entre celles que j'ai trouvé sur le net et ce que j'avais déjà de côté mais ca finissait soit par une création illimité d'onglet soit par des solutions de contournement mixant formules alambiquées, macro dans le workbook et worksheet et surtout à un gros raté...
Je vous tiens au courant et merci mille fois encore pour votre aide!
Theze
Je viens de tester chez moi, c'est parfait!
Je tente de comprendre avec mon faible niveau, je ne pige pas la dernière fonction codée... si tu peux m'éclairer...
Mferrand :
Effectivement, le résultat est assez différent (j'ai besoin de celle de Theze car le fichier va servir à visualier l'évolution du traitement du service concernée au fil des mois) mais le résultat m'interresse beaucoup car il peut être une excellente alternative à la création d'un fichier "physique" différent, je pense que je vais pouvoir la caser à un moment. Je pense également qu'effectivement la destruction de la fiche précedente serait une bonne solution histoire d'assurer une performance optimale à l'ouverture.
Une question : Je tente de m'y mettre (au VBA), j'ai acheté un "VBA pour les nuls", je ne sais pas trop ce que cela vaut. Au vu de ce que vous avez codé, je me demande vraiment comment vous avez appris. Vous pouvez me dire? Via un site? Via des bouquins? à l'école?
Dites moi!!! Parceque vu la puissance du language ça pourrait vraiment me simplifier la vie dans pas mal de cas au lieu de toujours trouver des solutions faites à base de détournement de formules !
Version simplifiée...
Sub MoisSuivant()
Dim mois, nom$, a%, i%, m%
mois = Split("JANVIER FEVRIER MARS AVRIL MAI JUIN JUILLET AOUT SEPTEMBRE OCTOBRE NOVEMBRE DECEMBRE")
With ActiveSheet
a = .Range("C9").Value
nom = .Range("C8").Value
For i = 0 To 11
If nom = mois(i) Then
m = (i + 1) Mod 12
Exit For
End If
Next i
If m = 0 Then a = a + 1
nom = mois(m)
.Name = nom
.Range("C9").Value = a
.Range("C8").Value = nom
.Range("C6").Value = nom & "_" & a
End With
End Sub
L'école était déjà loin derrière moi quand j'ai commencé
Ce qu'il est utile d'étudier (et d'expérimenter ensuite...) au départ pour avoir une vue un peu générale des possiblités : les variables (et leur portée), les tableaux, les boucles, (peut-être aussi la manipulations des instructions conditionnelles), et connaître le modèle-objet Excel puisque c'est là-dessus qu'on travaille. Et ne pas hésiter à se référer à l'Aide, qui ne règle pas tout mais donne tout de même pas mal d'indications.
Tu pourras aussi trouver pas mal de tutos à caractère général sur divers sites...
Cordialement
Bonjour,
J'ai commenté le code pour que tu comprennes mieux son fonctionnement :
Sub NouvelleFeuille()
Dim AcienMois As String
Dim NouveauMois As String
Dim Fe As Worksheet
'si la feuille active est celle du mois de décembre, message et sortie de procédure
If ActiveSheet.Name = "DECEMBRE" Then
MsgBox "Tous les mois de cette année ont été créés !"
Exit Sub
End If
'appelle la fonction pour récupérer le mois suivant par rapport à la feuille active
NouveauMois = NomMois(ActiveSheet.Name)
'appelle la fonction de contrôle avec en argument le nouveau nom
'si la fonction retourne Vrai (True) cette feuille existe déjà, message et fin de procédure
If Existe(NouveauMois) = True Then
MsgBox "Le mois suivant existe déjà !"
Exit Sub
End If
'mémorise le nom de la feuille active
AcienMois = ActiveSheet.Name
'puis création de la nouvelle feuille qui est mise à la suite
ActiveSheet.Copy After:=Sheets(Sheets.Count)
'la nouvelle feuille devient la feuille active, la renomme
ActiveSheet.Name = NouveauMois
'effectue les remplacements dans les cellules
ActiveSheet.Cells.Replace AcienMois & "_" & Year(Date), NouveauMois & "_" & Year(Date)
End Sub
Function NomMois(NomFeuille As String) As String
Dim TblMois()
Dim I As Integer
'crée un tableau contenant les noms des mois
TblMois = Array("JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE")
'boucle pour connaître le mois concerné si trouvé, la fonction retourne le mois suivant
For I = 0 To UBound(TblMois)
If NomFeuille = TblMois(I) Then
NomMois = TblMois(I + 1)
Exit For
End If
Next I
End Function
Function Existe(NomFeuille As String) As Boolean
Dim Fe As Worksheet
'boucle sur les feuilles pour voir si une feuille porte déjà le nouveau nom
'si c'est le cas mets fin à la boucle et la fonction retourne Vrai (True)
For Each Fe In Worksheets
If Fe.Name = NomFeuille Then
Existe = True
Exit For
End If
Next Fe
End Function
Bonjour
Je viens de passer ces 2 derniers jours à mettre en place et à bosser sur mes fichiers. Je viens de terminer et j'ai donc pu procéder à un test, c'est nikel ça fonctionne parfaitement pour de bon. Le temps de traitement est d'environ 1min30 (vu le nombre de liens c'est pas mal).
C'est impeccable!
Merci encore pour votre aide !
Maintenant que le boulot est en grande partie bouclé je vais pouvoir plancher sur les commentaires de la macro de Theze !!!