VBA enregistrement avec incrémentation

Bonjour à tous,

mon code enregistre avec une incrémentation. Le problème est que au dela de la première incrémentation, le fichier incrémenté est écrasé par la suite.

Je voudrais que les fichiers s'enregistrent : fichier, fichier_1, fichier_2, etc...

Merci pour votre aide

Dim sChemin As String, sDossier As String, nom_fichier As String
Dim NomFeuil As String, NexistePas As Boolean, Caractere As String
Dim ListLiens, i As Long
Dim y As Long
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

        ActiveSheet.Pictures.Visible = False

        NomFeuil = Range("C14").Text

        sDossier = ThisWorkbook.Path & "\" & NomFeuil
        nom_fichier = sDossier & "\" & "Commande " & NomFeuil

        With ActiveSheet
            .Copy
            With ActiveWorkbook

            ListLiens = ActiveWorkbook.LinkSources
            For i = LBound(ListLiens) To UBound(ListLiens)
                ActiveWorkbook.BreakLink ListLiens(i), xlLinkTypeExcelLinks
            Next i
            y = y + 1
                .SaveAs Filename:=nom_fichier & " - " & Format([D5], "dd-mm-yyyy") & " _ " & y, FileFormat:=51 'xlOpenXMLWorkbook
                .Close
            End With
        End With

        ActiveSheet.Pictures.Visible = True

        MsgBox "Le bon de commande [" & Range("C14") & "] est bien enregistré dans le dossier [" & nom_fichier & "]"

   Application.EnableEvents = True
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True

Bonjour,

De mémoire, je pense que le souci est qu'excel peut comprendre que activeworkbook est en fait le fichier qui contient le code.

Essayez en déplaçant la ligne ci-dessous juste après le NEXT i

With ActiveWorkbook

Au besoin, le laisser là mais rajoutez un --> .Activate juste en dessous

NB : les deux instructions application.enableevent ne servent pas. Supprimez-les

Crdlt

Malheureusement ca ne résoud pas le probleme d'incrémentation.

j'ai contourné le problème en ajoutant

Format(Time, "hhmmss")

Cela ne nécessite meme plus de vérifier si le fichier existe déjà ou non.

Bonjour

Malheureusement ca ne résoud pas le probleme d'incrémentation.

Ok je pense avoir compris le souci. En fait le Y = Y +1 ne sert pas en puisque vous exécutez chaque fois le code avec Y = 1. Du coup, cela écrase chaque fois le fichier précédent. Si vous aviez fait une boucle pour la sauvegarde de plusieurs fichiers, le Y prenait tout son sens.

En tenant compte de votre soution avec format(Time..., le code comme ceci devrait être mieux

Sub test()
Dim sChemin As String, sDossier As String, nom_fichier As String, NomFeuil As String
Dim ListLiens
Dim i as byte

Application.ScreenUpdating = False
Application.DisplayAlerts = False

With ThisWorkbook
    .ActiveSheet.Pictures.Visible = False

    NomFeuil = .ActiveSheet.Range("C14").Text
    sDossier = .Path & "\" & NomFeuil
    nom_fichier = sDossier & "\" & "Commande " & NomFeuil

    .ActiveSheet.Copy

    With ActiveWorkbook
        ListLiens = .LinkSources
        For i = LBound(ListLiens) To UBound(ListLiens)
            .BreakLink ListLiens(i), xlLinkTypeExcelLinks
        Next i
        'y = y + 1
        '.SaveAs Filename:=nom_fichier & " - " & Format([D5], "dd-mm-yyyy") & " _ " & y, FileFormat:=51 'xlOpenXMLWorkbook
        .SaveAs Filename:=nom_fichier & " - " & Format([D5], "dd-mm-yyyy") & format(time, "hhmmss") , FileFormat:=51 'xlOpenXMLWorkbook
        .Close
    End With

    .Pictures.Visible = True
End With

MsgBox "Le bon de commande [" & NomFeuil & "] est bien enregistré dans le dossier [" & nom_fichier & "]"

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

J'ai laissé les lignes contenant le Y en les désactivant pour le cas où vous voudriez les conserver et modifié quelques lignes
Reste le D5 pour lequel je pense que vous devriez aussi préciser la feuille.

Faites un test pour vérifier.

Si ok et terminé pensez à

Cordialement