Enregistrer sous sans doublon

Bonjour le forum,

j'ai un petit problème concernant l'enregistrement sous mais sans doublon, je m'explique :

J'ai un code VBA que j'ai trouvé sur le net qui me convient après quelques modifs à ma facon qui crée un fichier excel, le renome, colle des données dedans, le sauvegarde à un endroit défini et le ferme

le code concerné est le suivant :

Sub AddNewWorkbook()

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim DernLigne As Integer
Dim madate

madate = Format(Date, "dd-mm-yyyy")
DernLigne = Range("A" & Rows.Count).End(xlUp).Row

    Sheets("feuil1").Visible = True
    Sheets("feuil1").Cells.Copy
    'On créer l'objet Excel
    Set xlApp = CreateObject("Excel.Application")
    'On défini le nombre d'onglets (ici 5)
    xlApp.SheetsInNewWorkbook = 1
    'On ajoute un classeur
    Set xlBook = xlApp.Workbooks.Add
    'On donne un nom au classeur
    xlBook.SaveAs ("C:\" & madate & ".xlsx") 'changer l'adresse de l'enregistrement
    'On rend le classeur visible
    xlApp.Visible = True
    'On créer l'objet onglet dans le nouveau classeur créé
    'Set xlSheet = xlBook.Worksheets(1)
    'On affecte un nom aux l'onglets
    'xlSheet.Name = madate
    xlBook.Save
    xlBook.Close

    Workbooks.Open Filename:="C:\" & madate & ".xlsx"  'a renomer quand chamgement de pc
    Sheets("Sheet1").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths
    ActiveSheet.Paste

    With Workbooks(madate & ".xlsx")
        .Save
        .Close
    End With

    'On ferme l'application
    'xlApp.Quit
    Application.CutCopyMode = False
End Sub

Est-ce possible de modifier ce code pour que si le fichier existe déjà ça rajoute par exemple "(1)" dans le nom sans demander à l'utilisateur s'il veut le remplacer ou pas que ça se fasse automatiquement

Merci d'avance

Bonsoir,

Je ne trouve pas vraiment rationnel ni judicieux de passer par la création d'une 2e instance d'Excel pour créer un classeur ! Mais libre à toi... !

Cordialement.

Bonjour,

désolé mais je ne sais pas ce qu'est la 2ème instance... J'ai juste récupéré ce code qui fonctionne pour moi

Si jamais tu as mieux n'hésite pas

Pas très compliqué à comprendre : tu serais en train de travailler sous Word, ou Powerpoint.... avec ce code tu ouvres Excel et tu y fais quelques opérations...

Etant sous Excel, déjà, avec ce même code, tu ouvres un 2e Excel ! Tu peux tester manuellement l'ouverture de deux instances d'Excel et constater en allant dans l'editeur VBA dans chacune que tu ne vois pas ce qui se trouve dans l'autre...

C'est pourquoi je disais que si le but était de créer un classeur, la méthode est quelque peu contournée , alors que créer un classeur dans ton Excel initial se faisait simplement avec :

Workbooks.Add

Cordialement.

Bonjour,

Erreur sujet.

Cdlt.

Re,

C'est de nouveau moi.

Essaie ainsi :

Option Explicit

Public Sub AddNewWorkbook()
Dim xlSheet As Worksheet
Dim strDate As String, strFullName As String
Dim n As Long

    With Application
        n = .SheetsInNewWorkbook
        .SheetsInNewWorkbook = 1
        .ScreenUpdating = False
    End With

    strDate = Format(Date, "dd-mm-yyyy")
    strFullName = "C:\" & Format(Now, "yyyymmdd hh-mm") & ".xlsx"
    Set xlSheet = ActiveWorkbook.Worksheets("Feuil1")
    With xlSheet
        .Visible = True
        .Copy
    End With

    ActiveSheet.Name = strDate

    With ActiveWorkbook
        .SaveAs strFullName, 51
        .Close
    End With

    With Application
        .CutCopyMode = False
        .SheetsInNewWorkbook = n
    End With

End Sub

Merci pour les réponses et les explications

J'ai pensé aussi à l’altérative de rajouter l'heure au nom du fichier c'est ce que j'ai fait

Pour le reste je vais essayer et reviendrais vers vous

merci

Bonjour,

désolé de répondre que maintenant mais j'ai été très occupé ces derniers temps :/

pour revenir à ton code Jean-Eric je pense qu'il sera beaucoup mieux que le mien comme l'a fait entendre MFerrand

n'ayant pas trop de temps pour vérifier tout ça avant ma présentation de mon programme j'ai une dernière chose que je me suis aperçu pour la sauvegarde

si c'était possible de choisir un autre chemin de sauvegarde si le premier n'est pas dispo et ça sans aucun message ou choix a faire par l'utilisateur, je m'explique :

en lançant la macro, le programme enregistre le nouveau fichier excel par exemple sur un lecteur H: (clé usb)

mais si celui-ci n'est pas connecté je voudrais que ça sauvegarde sur le C:

en gros = si la sauvegarde sur H: échoue alors sauvegarder sur C: (ce qui sera une sauvegarde sûr au 2èm cas)

Merci d'avance

Bonjour,

Essaie ainsi :

Public Sub AddNewWorkbook()
Dim xlSheet As Worksheet
Dim strDate As String, strFullName As String
Dim n As Long

    With Application
        n = .SheetsInNewWorkbook
        .SheetsInNewWorkbook = 1
        .ScreenUpdating = False
    End With

    strDate = Format(Date, "dd-mm-yyyy")
    strFullName = "H:\" & Format(Now, "yyyymmdd hh-mm") & ".xlsx"
    Set xlSheet = ActiveWorkbook.Worksheets("Feuil1")

    With xlSheet
        .Visible = True
        .Copy
    End With

    ActiveSheet.Name = strDate

    On Error GoTo err_Handler
    With ActiveWorkbook
        .SaveAs strFullName, 51
        .Close
    End With

exit_Handler:
    With Application
        .CutCopyMode = False
        .SheetsInNewWorkbook = n
    End With
    Exit Sub

err_Handler:
    strFullName = "C:\" & Format(Now, "yyyymmdd hh-mm") & ".xlsx"
    With ActiveWorkbook
        .SaveAs strFullName, 51
        .Close
    End With
    Resume exit_Handler

End Sub

Bonjour,

J'ai essayé ton code Jean-Eric il fonctionne beaucoup mieux que le mien ^^

Cependant il y a un petit problème et je ne sais pas d'où cela peut provenir, c'est le message suivant :

Comment puis-je faire pour pas que ce message s'affiche??

merci d'avance

Bonjour,

A l'apparition du message, tu cliques sur Non, et tu enregistres ton classeur avec l'extension xlsm au lieu de xlsx.

Cdlt.

Bonjour Jean-Eric,

pour moi je sais bien mais pour les autres utilisateurs ils ne savent pas :/

mais pourquoi ça me mets ce message alors qu'il n'y a pas de macro dans le fichier créé??

de plus il est en extension xlsx...

donc comment puis-je faire pour pas que cela se produise??

Re,

J'ai répondu sans vraiment réflechir.

Essaie ainsi :

Option Explicit

Public Sub AddNewWorkbook()
Dim xlSheet As Worksheet
Dim strDate As String, strFullName As String
Dim n As Long

    With Application
        n = .SheetsInNewWorkbook
        .SheetsInNewWorkbook = 1
        .ScreenUpdating = False
    End With

    strDate = Format(Date, "dd-mm-yyyy")
    strFullName = "H:\" & Format(Now, "yyyymmdd hh-mm") & ".xlsm"
    Set xlSheet = ActiveWorkbook.Worksheets("Feuil1")

    With xlSheet
        .Visible = True
        .Copy
    End With

    ActiveSheet.Name = strDate

    On Error GoTo err_Handler
    With ActiveWorkbook
        .SaveAs strFullName, 52
        .Close
    End With

exit_Handler:
    With Application
        .CutCopyMode = False
        .SheetsInNewWorkbook = n
    End With
    Exit Sub

err_Handler:
    strFullName = "C:\" & Format(Now, "yyyymmdd hh-mm") & ".xlsm"
    With ActiveWorkbook
        .SaveAs strFullName, 52
        .Close
    End With
    Resume exit_Handler

End Sub

Rebonsoir Jean-Eric

Je suis désolé mais c'est moi qui me suis foiré un peu lol j'avais oublier de supprimer le code d'un bouton sur ma feuille alors qu'il ne devrait pas en avoir pour ça qu'il y avait le message pour enregistrer le fichier avec macro

Mais dans les 2 cas ton code fonctionne avec et sans prise en charge de macro

Merci beaucoup de ton aide tout fonctionne correctement et mieux encore

A bientôt pour un nouveau problème ^^