XL 2010 Sauvegarde d'un fichier avec incrémentation

GALOUGALOU à dit:

bonjour le forum
re romain31
essayer ce code

VB:

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

Cliquez pour agrandir...

Romain31 à dit:

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.

Cliquez pour agrandir...