XL 2019 3 repertoires

[DANIELRAG]

Bonjour,
En recherchant une solution à mon problème , j'ai trouvé un code VBA qui me convient parfaitement.
Cependant , j'ai besoin de faire les copies avec dates dans un répertoire différent, mais je ne sais pas comment faire.
La première sans les dates reste dans un dossier c: nommé fichier
La deuxième dans un répertoire d: nommé sauvegarde

.
Voici le code fait par patricktoulon.


Sub savefichier()
Dim chemin$, dat As Date, f, a&, oldfich$
chemin = ThisWorkbook.Path & "\"
BaseName = "monfichier"
dat = Now()
f = Dir(chemin & "monfichier*.xls*")
Do While f <> ""
a = a + 1
fdt = CDate(FileDateTime(chemin & f))
If f <> ThisWorkbook.Name Then If fdt < dat Then dat = CDate(fdt): oldfich = chemin & f
f = Dir
Loop
If a >= 3 Then Kill oldfich
ThisWorkbook.SaveCopyAs chemin & BaseName & "_" & Format(Now, "dd-mm-yyyy hh""H""mm""m""ss") & ".xlsm"
ActiveWorkbook.Save
End Sub

Merci pour aide
DanielRag

 

[fanch55]

Bonjour,

Sub test()
    savefichier "répertoire 1"
    savefichier "répertoire 2"
    savefichier "répertoire 3"
End Sub

Sub savefichier(Chemin$)
' PatrickToulon
    Dim dat As Date, f, a&, oldfich$
    Chemin = Chemin & "\"
    BaseName = "monfichier"
    dat = Now()
    f = Dir(Chemin & "monfichier*.xls*")
    Do While f <> ""
        a = a + 1
        fdt = CDate(FileDateTime(Chemin & f))
        If f <> ThisWorkbook.Name Then If fdt < dat Then dat = CDate(fdt): oldfich = Chemin & f
        f = Dir
    Loop
    If a >= 3 Then Kill oldfich
    ThisWorkbook.SaveCopyAs Chemin & BaseName & "_" & Format(Now, "dd-mm-yyyy hh""H""mm""m""ss") & ".xlsm"
    ActiveWorkbook.Save
End Sub

 

[DANIELRAG]

Bonjour fanch55

Merci pour le retour.
J'ai essayé mais cela ne marche pas.
Il faut dire que je suis plus que nul en VBA.
Je vous laisse le fichier afin de voir le résultat que j'obtiens.
J'ai besoin que la sauvegarde en C: soit sans date, heure, mm, ss Simplement avec son nom : mon fichier. Afin de pouvoir l'appeler à chaque fois.
La sauvegarde en D: elle doit avoir la date , etc.. et de limiter les copies à 3 exemplaires. Chaque nouvelle sauve remplaçant la plus ancienne.
Merci encore.
Daniel