XL 2010 Sauvegarde d'un fichier avec incrémentation

[Romain31]

Bonjour à toutes et à tous,

Je souhaite réaliser une sauvegarde de ce fichier dans un dossier C:\sauvegarde (qui est créé, s'il n'existe pas).
Les sauvegardes sont datées et incrémentées (exemple : test.24-02-2022001.xls, test.24-02-2022002.xls).
Et cela, à chaque fois que je lance la macro.
Cette macro fonctionne parfaitement pour les deux premiers lancements.
Mais elle ne génère plus de sauvegarde lorsqu'on la relance de nouveau.
Merci pour votre aide et excellente journée.

 

[GALOUGALOU]

bonjour le forum
re romain31
essayer ce code

Sub test()
Dim Répertoire As Variant
Dim nf As Variant
Dim n As Integer



  ThisWorkbook.Save
  Répertoire = "c:\sauvegarde"
  If Dir(Répertoire, vbDirectory) = "" Then MkDir Répertoire
   nf = Dir(Répertoire & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & _
     Format(Now, "dd-mm-yyyy") & Format(n + 1, "000") & ".xls")

  Do While nf <> ""
    nf = Dir
    n = Sheets("Feuil1").Range("F1")
    If Sheets("Feuil1").Range("F1") = "" Then n = 1
    If Sheets("Feuil1").Range("F1") <> "" Then Sheets("Feuil1").Range("F1") = n + 1
  Loop
 
  ThisWorkbook.SaveCopyAs Répertoire & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & _
     Format(Now, "dd-mm-yyyy") & Format(n + 1, "000") & ".xls"
End Sub

j'ai choisi la cellule F1 pour un test, la cellule f1 garde l'incrémentation historique
si f1 = rien alors f1 est égal à 1
si f1 est différent de rien alors j'ajoute 1 à la cellule F1
cdt
galougalou

 

[Romain31]

bonjour le forum
re romain31
essayer ce code

Sub test()
Dim Répertoire As Variant
Dim nf As Variant
Dim n As Integer



  ThisWorkbook.Save
  Répertoire = "c:\sauvegarde"
  If Dir(Répertoire, vbDirectory) = "" Then MkDir Répertoire
   nf = Dir(Répertoire & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & _
     Format(Now, "dd-mm-yyyy") & Format(n + 1, "000") & ".xls")

  Do While nf <> ""
    nf = Dir
    n = Sheets("Feuil1").Range("F1")
    If Sheets("Feuil1").Range("F1") = "" Then n = 1
    If Sheets("Feuil1").Range("F1") <> "" Then Sheets("Feuil1").Range("F1") = n + 1
  Loop
 
  ThisWorkbook.SaveCopyAs Répertoire & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & _
     Format(Now, "dd-mm-yyyy") & Format(n + 1, "000") & ".xls"
End Sub

j'ai choisi la cellule F1 pour un test, la cellule f1 garde l'incrémentation historique
si f1 = rien alors f1 est égal à 1
si f1 est différent de rien alors j'ajoute 1 à la cellule F1
cdt
galougalou

Bonjour Galougalou,

Je te remercie pour ta réponse.
Hélas, c'est la même chose, tout s'arrête après deux sauvegardes.
Ce que je ne m'explique pas, c'est que ce code me semble-t-il, fonctionnait bien en 2020 car je l'avais déjà employé dans une appli sur Excel 2010 et 2013.

 

[Romain31]

Bonjour Galougalou,

Je te remercie pour ta réponse.
Hélas, c'est la même chose, tout s'arrête après deux sauvegardes.
Ce que je ne m'explique pas, c'est que ce code me semble-t-il, fonctionnait bien en 2020 car je l'avais déjà employé dans une appli sur Excel 2010 et 2013.

J'ai écrit trop vite.
C'est ok.
Grand merci Galougalou et très belle journée à tous