HELP !!! Sauvegarder 1 fichier en fction de la date mêm si plusieurs par jour

R

Romain

Guest
Ayant une expérience très récente sur les codes, macros,etc sur Excel..
Je suis confronté à un problème !

J'aimerai à partir du bouton ki est inséré ds mon fichier (en pièce jointe) et ki est appelé "Copie & Sauve" : copier le tableau que j'ai sur ma feuille sur un nouveau document excel et le sauvegarder automatiquement en fonction du jour ou la copie est faite
Sauvegarder ds un dossier : par exemple en ce moment "FEVRIER 2004"
>>> puis ds ce dossier un autre appelé par exemple 17-02-04
>>> et enfin le fichier ki se met ds ce dossier avec pour
nom "MORLAIX1"

et ainsi ke si je resauvegarde un nvo fichier le mm jour il s'enregistre sous le nom "MORLAIX2" et ainsi de suite....

puis le lendemain :18-02-04 >>>> MORLAIX1
MORLAIX2,....

C'est une méthode très utile d'archivage ke je n'arrive pas à créer..
J'espère ke kk'1 pourra m'aider o plus vite...... car je suis perdu !

Avis o experts car je suis tro débutant en la matière

Merci d'avance pr votre aide !

Romain
 

Pièces jointes

  • ProblemeSauvegarde.zip
    5.5 KB · Affichages: 21
M

michel

Guest
Re: Sauvegarder fichier dans un repertoire en fonction de la date

bonjour Romain

j'espere que l'exemple ci joint pourra t'aider
une copie du classeur est crée dans un repertoire specifique
les repertoires et sous repertoires sont créés dans le meme dossier que le classeur d'origine ( à adapter en fonction de ton projet )

Sub CopieArchivage()
Dim Dossier1 As String, SousDossier2 As String
Dim Cible As Object, Dossier As Object

Dossier1 = ThisWorkbook.Path & "\" & Format(Date, "mmmm yy")
If Dir(Dossier1, vbDirectory) = "" Then MkDir (Dossier1)
SousDossier2 = Dossier1 & "\" & Format(Date, "dd mm yy")
If Dir(SousDossier2, vbDirectory) = "" Then MkDir (SousDossier2)

Set Cible = CreateObject("Scripting.FileSystemObject")
Set Dossier = Cible.GetFolder(SousDossier2)

ThisWorkbook.SaveCopyAs FileName:=SousDossier2 & "\MORLAIX" & Dossier.files.Count + 1 & ".xls"

Set Cible = Nothing
End Sub

bonne soirée
michel
lapin4.gif
 

Statistiques des forums

Discussions
312 229
Messages
2 086 426
Membres
103 206
dernier inscrit
diambote