Enregistrement de fichier incrémenté...?

Bonsoir à tous,

Je cherche à modifier une macro trouvée sur le web...

que j'ai placé dans le module "Mod_MéthodeFSO".

Mais elle n'incrémente pas correctement mon fichier, elle devrait incrémenter V01, V02, V03, etc..., elle me demande si je veux écraser le fichie rexistant...

Pouvez vous m'aider à la faire obéir...

Merci à vous tous...

Mon fichier joint :

Pour bien se rendre compte, il faut la mettre seule dans un dossier spécifique.

Bonjour,

la fonction Dir() fait très bien l'affaire, pas nécessaire d'utiliser FSO !

Ici, j'ai monté le système avec deux fonctions, la fonction "Fichiers()" qui retourne un tableau de type String contenant les noms des fichiers correspondants au filtre qui est "*-V??.xls*" et la fonction "NomFichier()" qui construit et retourne le nom disponible portant le nombre le plus élevé. J'ai fais ça pour plus de clarté mais les deux fonctions peuvent être réunies :

Sub Test()

    Dim Chemin As String
    Dim PartieFich As String
    Dim Nom As String

    Chemin = ThisWorkbook.Path & "\"

    'les fichiers doivent avoir un "-" puis un "V" puis deux caractères et enfin ".xls", sont retournés tous les .xls, .xlsm, .xlsx, etc...
    PartieFich = "*-V??.xls*"

    Nom = NomFichier(Chemin, PartieFich)

    If Nom = "" Then MsgBox "Aucun fichier !" Else MsgBox Nom

End Sub

Function NomFichier(Chemin As String, Partie As String) As String

    Dim Tbl() As String
    Dim Nom As String
    Dim Num As Integer
    Dim Max As Integer
    Dim I As Integer

    Tbl() = Fichiers(Chemin, Partie)

    If Not Not Tbl Then

        For I = 1 To UBound(Tbl)

            If IsNumeric(Mid(Tbl(I), (InStr(Tbl(I), ".")) - 2, 2)) Then Num = Mid(Tbl(I), (InStr(Tbl(I), ".")) - 2, 2)
            If Num > Max Then Max = Num

        Next I

        NomFichier = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, "-V")) & "V" & Format(Max + 1, "00")

    End If

End Function

Function Fichiers(Chemin As String, Partie As String) As String()

    Dim TableauFichiers() As String
    Dim Fichier As String
    Dim I As Integer

    Fichier = Dir(Chemin & Partie)

    Do While (Len(Fichier) > 0)

        I = I + 1
        ReDim Preserve TableauFichiers(1 To I)
        TableauFichiers(I) = Fichier
        Fichier = Dir()

    Loop

    Fichiers = TableauFichiers()

End Function

Bonjour Theze,

Merci, c'est parfait...

Pour finaliser ton code, j'ai juste eu à remplacer :

Else MsgBox Nom

par :

Else ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Nom

et mon fichier s'incrémente bien dans son dossier d'origine...

Merci beaucoup...

Co ntent de t'avoir aidé