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 !!!

17test.xlsm (25.00 Ko)

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

21kev-test.xlsm (28.20 Ko)

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é . On apprend surtout en programmant, en faisant des erreurs, en recommençant... Ceci dit, lorsque Microsoft a passé Excel sous VBA pour les macros (avec Excel 5, en 93 je crois), il avait sorti 2 bouquins d'accompagnement : un ne faisait que reproduire l'aide, mais l'autre était consacré aux principes de programmation en général et avec VBA en particulier. Je l'avais à l'époque trouvé bien utile...

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 !!!

Rechercher des sujets similaires à "duplication onglet dynamique"