Sub Enregistrer()
Dim chemin$, racine$, fichier$, maxi%
With ThisWorkbook
chemin = .Path & "\" 'dossier à adapter
racine = Left(.Name, Len(.Name) - 8)
fichier = Dir(chemin & racine & "*.xlsm") '1er fichier du dossier
While fichier <> ""
If fichier Like racine & "###.xlsm" Then
If Val(Mid(fichier, Len(racine) + 1)) > maxi Then maxi = Val(Mid(fichier, Len(racine) + 1))
End If
fichier = Dir 'fichier suivant
Wend
.SaveAs chemin & racine & Format(maxi + 1, "000") 'enregistrement avec incrémentation du nom
End With
End Sub