XL 2019 Copie feuille active dans répertoire avec nom fichier dynamique

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion guiyom
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
G

guiyom

XLDnaute Junior
Bonjour,

Je sollicite votre aide afin de trouver une solution à mon problème certainement ridicule mais au dessus de mes capacités.

J'utilise une macro me permettant d'effectuer une copie de ma feuille active dans un répertoire défini avec un nom déterminé par la date du jour.
Le problème étant que j'utilise cette macro parfois plusieurs fois par jours et donc à chaque fois la précédente sauvegarde est écrasée par la nouvelle.

Je souhaiterai qu'un petit compteur à la fin du nom du fichier s'inscrive si j'utilise la macro plusieurs fois dans la même journée.

Exemple :
test du 01/11/2019
test du 01/11/2019(1)
test du 01/11/2019(2)

Voici le code utilisé :

VB: 
Sub RAZ()
Dim jour As String, mois As String, annee As String


jour = Cells(1, 1).Value
mois = Cells(1, 2).Value
annee = Cells(1, 3).Value

    Sheets("Feuil1").Copy
    Sheets("Feuil1").Name = "test" & jour & mois & annee
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="C:\Users\PC\Desktop\Nouveau dossier (4)" + "\test du " & jour & "." & mois & "." & annee & ".xlsm", _
    FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    Application.DisplayAlerts = True
    ActiveWorkbook.Close

End Sub

Cordialement
 
Trier par date Trier par votes
Bonjour Guiyom, bonjour le forum,

Peut-être comme ça :
VB: 
Sub RAZ()
Dim jour As String, mois As String, annee As String
Dim NomFichier As String 'déclare la variable NomFichier
Dim F As String 'déclare la variable F (Fichier)
Dim PCN As String 'déclare la variable PCN (Premières Caractères du Nom))
Dim DN As Integer 'déclare la variable DN (Dernier Numéro)
Dim DNM As Integer 'déclare la variable DNM (Dernier Numéro Max)

jour = Cells(1, 1).Value
mois = Cells(1, 2).Value
annee = Cells(1, 3).Value
NomFichier = "test du " & jour & "." & mois & "." & annee 'définit le nom du fichier NomFichier en fonction de la date
F = Dir("C:\Users\PC\Desktop\Nouveau dossier (4)\*.xlsm") 'définit le premier fichier xlsm du dossier spécifié
Do While F <> "" 'exécutre tant qu'il existe des fichiers F
    If InStr(1, F, NomFichier) <> 0 Then 'condition 1 : si le texte de NomFichier est contenu dans le texte de F
        If UBound(Split(F, ")")) > 0 Then 'condition 2 : s'il existe dans F caractère ")"
            PCN = Split(F, ")")(0) 'récupère dans la variable PCN le texte avant ce caratère
            DN = CInt(Split(PCN, "(")(1)) + 1 'définit le dernier numéro DN (les caractères de PCN après "(" convertis en entier + 1)
            If DN > DNM Then DNM = DN 'si DN est supérieure à DNM alors DBM devient DN (permet d'obtenir le numéro maximum)
        Else 'sinon (condition 1)
            DNM = 0 'définit DNM
        End If 'fin de la condition 2
    End If 'fin de la condition 1
    F = Dir 'définit le prochain fichier xlsm du dossier spécifié plus haut
Loop 'boucle
Sheets("Feuil1").Copy 'extrait l'onglet Feuil1 conne un nouveau fichier
Sheets("Feuil1").Name = NomFichier & " (" & DNM & ")" 'renomme l'onglet
'suvre le fichier avec NomFichier suivi de " (DNM).XLSM" (par exemple test du 01.11.2019 (0).xlsm
ActiveWorkbook.SaveAs Filename:="C:\Users\PC\Desktop\Nouveau dossier (4)\" & NomFichier & " (" & DNM & ").xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Close
End Sub
 
Vote positif 0 Vote négatif
Robert à dit:
Bonjour Guiyom, bonjour le forum,

Peut-être comme ça :
VB: 
Sub RAZ()
Dim jour As String, mois As String, annee As String
Dim NomFichier As String 'déclare la variable NomFichier
Dim F As String 'déclare la variable F (Fichier)
Dim PCN As String 'déclare la variable PCN (Premières Caractères du Nom))
Dim DN As Integer 'déclare la variable DN (Dernier Numéro)
Dim DNM As Integer 'déclare la variable DNM (Dernier Numéro Max)

jour = Cells(1, 1).Value
mois = Cells(1, 2).Value
annee = Cells(1, 3).Value
NomFichier = "test du " & jour & "." & mois & "." & annee 'définit le nom du fichier NomFichier en fonction de la date
F = Dir("C:\Users\PC\Desktop\Nouveau dossier (4)\*.xlsm") 'définit le premier fichier xlsm du dossier spécifié
Do While F <> "" 'exécutre tant qu'il existe des fichiers F
    If InStr(1, F, NomFichier) <> 0 Then 'condition 1 : si le texte de NomFichier est contenu dans le texte de F
        If UBound(Split(F, ")")) > 0 Then 'condition 2 : s'il existe dans F caractère ")"
            PCN = Split(F, ")")(0) 'récupère dans la variable PCN le texte avant ce caratère
            DN = CInt(Split(PCN, "(")(1)) + 1 'définit le dernier numéro DN (les caractères de PCN après "(" convertis en entier + 1)
            If DN > DNM Then DNM = DN 'si DN est supérieure à DNM alors DBM devient DN (permet d'obtenir le numéro maximum)
        Else 'sinon (condition 1)
            DNM = 0 'définit DNM
        End If 'fin de la condition 2
    End If 'fin de la condition 1
    F = Dir 'définit le prochain fichier xlsm du dossier spécifié plus haut
Loop 'boucle
Sheets("Feuil1").Copy 'extrait l'onglet Feuil1 conne un nouveau fichier
Sheets("Feuil1").Name = NomFichier & " (" & DNM & ")" 'renomme l'onglet
'suvre le fichier avec NomFichier suivi de " (DNM).XLSM" (par exemple test du 01.11.2019 (0).xlsm
ActiveWorkbook.SaveAs Filename:="C:\Users\PC\Desktop\Nouveau dossier (4)\" & NomFichier & " (" & DNM & ").xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Close
End Sub
Cliquez pour agrandir...

Incroyable, c'est exactement le résultat que je cherchais et plus important encore il y à toute les explications nécessaire à la compréhension du code.

Merci pour la rapidité de réponse ainsi que le temps consacré à mon problème.
 
Vote positif 0 Vote négatif
Bonjour,

Je sollicite à nouveau votre aide pour un détail qui m'intrigue.
J'ai modifier légèrement votre code afin qu'il puisse sauvegarder la feuille active en fonction de la date du jour dans un répertoire défini par l'année suivi d'un sous répertoire défini par le mois.
Il me créer donc pour la journée du 04/11/2019 :

c:\Desktop\Nouveau dossier (4)\2019\11\test du 4.11.2019 (0).xlsm

Cependant je souhaite savoir si il est possible de lui faire créer :

c:\Desktop\Nouveau dossier (4)\2019\Novembre\test du 4.11.2019 (0).xlsm

Vous trouverez en PJ le fichier.

Cordialement


PS : Je viens de me rendre compte que mes modifications entre en conflit avec l'idée de départ et écrase le fichier du jour précédent.
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Bonsoir le fil

Une autre version de la macro RAZ
VB: 
Sub RAZ_ter()
Dim vDate, strPath As String, cpt&
vDate = Date: strPath = ThisWorkbook.Path & "\"
On Error Resume Next
cpt = Evaluate("Compteur")
On Error GoTo 0
cpt = cpt + 1
ThisWorkbook.Names.Add Name:="Compteur", RefersTo:=cpt
Application.DisplayAlerts = False
Sheets("Feuil1").Copy
  With ActiveWorkbook
    .Sheets(1).Name = Format(vDate, """test""ddmmyyyy")
    .SaveAs strPath & Format(vDate, """test du ""ddmmyyyy_") & cpt & ".xlsm", FileFormat:=52
    .Close True
  End With
Application.DisplayAlerts = True
ThisWorkbook.Save
End Sub
 
Vote positif 0 Vote négatif
Staple1600 à dit:
Bonsoir le fil

Une autre version de la macro RAZ
VB: 
Sub RAZ_ter()
Dim vDate, strPath As String, cpt&
vDate = Date: strPath = ThisWorkbook.Path & "\"
On Error Resume Next
cpt = Evaluate("Compteur")
On Error GoTo 0
cpt = cpt + 1
ThisWorkbook.Names.Add Name:="Compteur", RefersTo:=cpt
Application.DisplayAlerts = False
Sheets("Feuil1").Copy
  With ActiveWorkbook
    .Sheets(1).Name = Format(vDate, """test""ddmmyyyy")
    .SaveAs strPath & Format(vDate, """test du ""ddmmyyyy_") & cpt & ".xlsm", FileFormat:=52
    .Close True
  End With
Application.DisplayAlerts = True
ThisWorkbook.Save
End Sub
Cliquez pour agrandir...

Bonsoir,
Merci pour cette nouvelle méthode.
De mon coté j'ai réussi à corriger les 2 problèmes rencontré dans mon précédent post.

Une erreur de syntaxe sur un " \ " concernant l'écrasement du précédent fichier et l'utilisation de la fonction MonthName(Month()) pour obtenir le mois en lettre.

Je poste au cas ou le fichier corrigé.

Cordialement
 

Pièces jointes

Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

S
  • Question Question
XL 2013 enregistrer une feuille excel converti en pdf dans un répertoire selon la valeur d'une cellule
Réponses
5
Affichages
160
Phil69970
Phil69970
C
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
70
CDALE
C
S
  • Résolu(e)
XL 2016 Coller nom classeur sur plage cellules
Réponses
9
Affichages
93
safranien
S
S
  • Question Question
XL 2019 Modifications avec Combobox liées
Réponses
7
Affichages
232
Dranreb
Dranreb
A
  • Résolu(e)
Microsoft 365 Enregistrer copie d'un fichier avec pour nom le contenu d'une cellule excel (macro)
2
Réponses
15
Affichages
887
firecarl
F
J
  • Question Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
123
JJ69
J
A
  • Résolu(e)
XL 2021 Céer un fichier (.text) avec VBA pour enregistrer les évènements dans un journal
Réponses
4
Affichages
527
arnoldbrice19
A
Nico2978
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
632
Nico2978
Nico2978
Nicolas JACQUIN
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
Nicolas JACQUIN
D
  • Résolu(e)
Microsoft 365 Problème interférences entre macros
Réponses
14
Affichages
146
Phil69970
Phil69970
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
302
Gestionnaire_rh
G
A
  • Question Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
213
patricktoulon
patricktoulon
jeff1494
  • Question Question
XL 2021 Comment supprimer des noms du gestionnaire de noms dans un classeur
Réponses
7
Affichages
377
jeff1494
jeff1494
M
  • Question Question
XL 2010 Aide à la suppression d'un produit en double dans un magasin spécifique avec conditions
Réponses
9
Affichages
788
Mody200
M
C
  • Résolu(e)
XL 2016 VBA : inversion de Date sur Range.Resize ... = Tableau après Transpose du Tableau
Réponses
2
Affichages
202
crocrocro
C
J
  • Question Question
XL 2021 enregistrer sous une feuille définie du classeur avec nom cellule
Réponses
5
Affichages
749
Eric KERGRESSE
E
S
  • Question Question
XL 2019 Calculer dimanche de pâques puis insertion du 29 février
2
Réponses
26
Affichages
489
dysorthographie
dysorthographie
G
  • Question Question
XL 2016 Extraire des données d'un pdf et les copier dans excel
2
Réponses
19
Affichages
1 K
kiki29
kiki29
G
  • Question Question
Microsoft 365 Réduire la taille de la macro ?
Réponses
9
Affichages
844
Staple1600
Staple1600
A
  • Question Question
XL 2016 Boucle sur sous répertoire fso.GetFolder SharePoint
Réponses
0
Affichages
865
Aldonanou
A
Retour