Enregistrer une feuille automatiquement a la fermeture du dossier

Bonjour

Dans mon Workbook j'aimerai que le system m'enregistre la feuille en plus dans le

dossier C:\Users\Utilisateur\kDrive

j'ai déjà ce code que je veux garder

Private Sub Workbook_BeforeClose(Cancel As Boolean)

' Enregistrer la feuille spécifique avant de fermer

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("saisies") ' Remplacez par le nom de votre feuille

' Sauvegarder le classeur

ThisWorkbook.Save

End Sub

Mais j'aimerai rajouter le sauvetage dans C:\Users\Utilisateur\kDrive

Bonjour Michel

Pour ne sauvegarder qu'une feuille, il faut copier celle-ci dans un nouveau classeur et sauvegarder celui-ci

A moins que ton classeur ne comporte qu'une feuille

A+

Je veux sauver tout le classeur à deux endroits différents

Bonjour,

Un script que j'ai sous le coude, à mettre dans ThisWorkBook

Modifier ces deux lignes de commande

Const Chemin1 = "C:\Users\Utilisateur\Downloads\"      ' emplacement 1 du fichier ex: fichier source
Const Chemin2 = "G:\toto\"                         ' emplacement 2 du fichier ex: fichier archive type clé USB etc:

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' terminer les constantes avec un anti-slash \
Const Chemin1 = "C:\Users\Utilisateur\Downloads\"      ' emplacement 1 du fichier ex: fichier source
Const Chemin2 = "G:\toto\"                         ' emplacement 2 du fichier ex: fichier archive type clé USB etc:

Dim chemin As String, QuelChemin As String

Application.EnableEvents = False
Application.DisplayAlerts = True

' 1- le fichier actif est sauvegardé sur lui-même
On Error GoTo Error001
chemin = ThisWorkbook.Path
QuelChemin = chemin
If Right(chemin, 1) <> "\" Then chemin = chemin & "\"
ThisWorkbook.Save

' 2- le fichier actif est copié sur Chemin1
'    si différent de Thisworkbook.fullname (idem pour chemin2)
QuelChemin = Chemin1
If LCase(chemin) <> LCase(Chemin1) Then ActiveWorkbook.SaveCopyAs Chemin1 & ThisWorkbook.Name
QuelChemin = Chemin2
If LCase(chemin) <> LCase(Chemin2) Then ActiveWorkbook.SaveCopyAs Chemin2 & ThisWorkbook.Name

Application.DisplayAlerts = True
Application.EnableEvents = True
Exit Sub

Error001:
  MsgBox "ATENTION " & vbCrLf & vbCrLf & "Le fichier actif n'a pas été sauvegardé sur : " & _
  vbLf & QuelChemin & "" & vbCrLf & vbCrLf & "Veuillez vérifier que le support " & _
        "externe ou réseau est accessible ou bien que le chemin existe"
  Application.DisplayAlerts = True
  Application.EnableEvents = True
  Exit Sub
End Sub

Sub Reactiver()
  Application.EnableEvents = True
End Sub

Merci mais complètement incompréhensible "POUR MOI"

J'ai actuellement ce code

Private Sub Workbook_BeforeClose(Cancel As Boolean)

' Enregistrer la feuille spécifique avant de fermer

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("saisies")

' Sauvegarder le classeur

ThisWorkbook.Save

End Sub

il enregistre le classeur en cours sur "C:\Base documentaire\Clausen Michel\Naturafit\Glycemie.xlsm

et j'aimerai qu'il l'enregistre aussi sur "C:\Users\Utilisateur\kDrive\Glycemie.xlsm

Re,

Alors un essai....... remplace ton code par celui-ci et teste

Sub Workbook_BeforeClose(Cancel As Boolean)
    ' Déclarer les variables
    Dim ws As Worksheet
    Dim chemin1 As String
    Dim chemin2 As String 
    ' Définir la feuille spécifique
    Set ws = ThisWorkbook.Sheets("saisies")
    ' Définir les chemins d'enregistrement
    chemin1 = "C:\Base documentaire\Clausen Michel\Naturafit\Glycemie.xlsm"
    chemin2 = "C:\Users\Utilisateur\kDrive\Glycemie.xlsm" 
    ' Sauvegarder le classeur dans le premier emplacement
    ThisWorkbook.SaveAs chemin1, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    ' Sauvegarder le classeur dans le second emplacement
    ThisWorkbook.SaveCopyAs chemin2
    ' Fermer le classeur
    ThisWorkbook.Saved = True

End Sub

Slts

Merci ça a l'air de fonctionner . il y a une petite erreur. je regarderai ça demain .

Encore merci

J'ai un petit problème avec ce code. J'ai chaque fois le message (voir fich

ier joint). Il faudrait simplement que chaque fois ça écrase les anciens fichiers

re,

ajouter la ligne "application.displayalerts=false" avant cette ligne et puis "...=true" après cette ligne (voir 1ier exemple de Boss_68)

Merci absolument rien compris

Sub Workbook_BeforeClose(Cancel As Boolean)
     ' Déclarer les variables
     Dim ws    As Worksheet
     Dim chemin1 As String
     Dim chemin2 As String
     ' Définir la feuille spécifique
     Set ws = ThisWorkbook.Sheets("saisies")
     ' Définir les chemins d'enregistrement
     chemin1 = "C:\Base documentaire\Clausen Michel\Naturafit\Glycemie.xlsm"
     chemin2 = "C:\Users\Utilisateur\kDrive\Glycemie.xlsm"
     ' Sauvegarder le classeur dans le premier emplacement
     Application.DisplayAlerts = False       '************************************************
     ThisWorkbook.SaveAs chemin1, FileFormat:=xlOpenXMLWorkbookMacroEnabled
     ' Sauvegarder le classeur dans le second emplacement
     ThisWorkbook.SaveCopyAs chemin2
     Application.DisplayAlerts = True        '************************************************
     ' Fermer le classeur
     ThisWorkbook.Saved = True

End Sub

Merci je vais tester bon dimanche