sauvegarder certaines feuilles sur un autre fichier

[nomzamo]

Bonjour le forum,
J'ai besoin d'aide, voici mon problème:
Mon classeur comporte des macros et se compose de 3 feuilles nommées « Travail » « Noms » « Valeurs » au départ.
Je fabrique ensuite d’autres feuilles comportant des tableaux et nommées d’un nom et d’une date.
Je voudrais pouvoir automatiser à l’aide d’une macro la sauvegarde uniquement des feuilles « nom date » sur un autre classeur sans les 3 feuilles « Travail » « Noms » « Valeurs » et sans les macros.
Merci de m'avoir lu,
Roger

 

[jpb388]

Re : sauvegarder certaines feuilles sur un autre fichier

Bonjour à tous

Sub CopierF()
'
' Copier une feuille dans un autre classeur
'
Dim Feuille As Worksheet, Chemin$, Filtre$, Titre$
For Each Feuille In Worksheets
    Select Case Feuille.Name 'on pourrait utiliser un if mais moi je préfère le select plus clair
        Case "Travail"
        Case "Noms"
        Case "Valeurs"
        Case Else
            Filtre = "Fichier Excel(*.xlsx),*.xlsx"
            Titre = "Ou voulez vous enregistrer vos feuilles?"
            Chemin = Application.GetSaveAsFilename(, Filtre, , Titre)
            If Chemin = "" Then Exit Sub
            Feuille.Copy
            ActiveWorkbook.SaveAs Filename:=Chemin, FileFormat _
            :=xlOpenXMLWorkbook, CreateBackup:=False
    End Select
Next Feuille
On Error Resume Next
ActiveWindow.Close
End Sub

Sub deplacerF()
'
' Déplacer une feuille dans un autre classeur
'
Dim Feuille As Worksheet, Chemin$, Filtre$, Titre$
For Each Feuille In Worksheets
    Select Case Feuille.Name 'on pourrait utiliser un if mais moi je préfère le select plus clair
        Case "Travail"
        Case "Noms"
        Case "Valeurs"
        Case Else
            Filtre = "Fichier Excel(*.xlsx),*.xlsx"
            Titre = "Ou voulez vous enregistrer vos feuilles?"
            Chemin = Application.GetSaveAsFilename(, Filtre, , Titre)
            If Chemin = "" Then Exit Sub
            Feuille.Move
            ActiveWorkbook.SaveAs Filename:=Chemin, FileFormat _
            :=xlOpenXMLWorkbook, CreateBackup:=False
    End Select
Next Feuille
On Error Resume Next
ActiveWindow.Close
End Sub

 

[nomzamo]

Re : sauvegarder certaines feuilles sur un autre fichier

Merci JP, c'est ce que je chaerchais.
en plus j'ai 2 solutions: copier et déplacer.
cordialement,
Roger

 

[nomzamo]

Re : sauvegarder certaines feuilles sur un autre fichier

Bonjour le forum,
Après avoir testé la solution de JP, j'ai effectivement l'exclusion des 3 feuilles mais ensuite une sauvegarde par feuille restante. J'aimerais avoir toutes les feuilles restantes sauvegardées dans un même classeur. Le nombre de feuille restant étant aléatoire.
Bonne journée,
Roger

 

[jpb388]

Re : sauvegarder certaines feuilles sur un autre fichier

Bonjour à tous
Teste et dis moi

Sub CopierF()
 '
 ' Copier une feuille dans un autre classeur
 '
 Dim Feuille As Worksheet, Chemin$, Filtre$, Titre$, Nb%
 Dim Wb1 As Workbook, Wb2 As Workbook
 Set Wb1 = ThisWorkbook
 For Each Feuille In Wb1.Worksheets
     Select Case Feuille.Name 'on pourrait utiliser un if mais moi je préfère le select plus clair
         Case "Travail"
         Case "Noms"
         Case "Valeurs"
         Case Else
            Nb = Nb + 1
            Select Case Nb
                Case Is = 1
                    Feuille.Select
                Case Else
                    Feuille.Select False
            End Select
     End Select
 Next Feuille
 Set Wb2 = Workbooks.Add
 Do
Filtre = "Fichier Excel(*.xlsx),*.xlsx"
Titre = "Ou voulez vous enregistrer vos feuilles?"
Chemin = Application.GetSaveAsFilename(, Filtre, , Titre)
If Chemin = "" Then Exit Sub
If Wb1.Name = Wb2.Name Then MsgBox "Veuillez indiquer un nom différent du fichier source Merci", vbInformation + vbOKOnly, "Nom Identique"
Loop Until Wb1.Name <> Wb2.Name
Selection.Copy
ActiveWorkbook.SaveAs Filename:=Chemin, FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
 
 On Error Resume Next
 ActiveWindow.Close
Set Wb1 = Nothing
Set Wb2 = Nothing
 End Sub

 

[nomzamo]

Re : sauvegarder certaines feuilles sur un autre fichier

Bonjour JP,
Je viens de tester: mon classeur source a bien les feuilles concernées sélectionnées mais la sauvegarde est un classeur vide. La macro exécutée en pas à pas s'arrête avant Selection.Copy. Ce n'est pas loin du but...
Merci pour ton aide.
Roger

 

[jpb388]

Re : sauvegarder certaines feuilles sur un autre fichier

re
essaye ceci

Sub CopierF()
  '
  ' Copier une feuille dans un autre classeur
  '
  Dim Feuille As Worksheet, Chemin$, Filtre$, Titre$, Nb%, FS$
  Dim Wb1 As Workbook, Wb2 As Workbook
  Set Wb1 = ThisWorkbook
  Set Wb2 = Workbooks.Add
  For Each Feuille In Wb1.Worksheets
      Select Case Feuille.Name 'on pourrait utiliser un if mais moi je préfère le select plus clair
          Case "Travail"
          Case "Noms"
          Case "Valeurs"
          Case Else
            Feuille.Copy After:=Wb2.Worksheets(Wb2.Worksheets.Count)
      End Select
  Next Feuille
  Do
 Filtre = "Fichier Excel(*.xlsx),*.xlsx"
 Titre = "Ou vou lez vous enregistrer vos feuilles?"
 Chemin = Application.GetSaveAsFilename(, Filtre, , Titre)
 If Chemin = "" Then Exit Sub
 If Wb1.Name = Wb2.Name Then MsgBox "Veuillez indiquer un nom différent du fichier source Merci", vbInformation + vbOKOnly, "Nom Identique"
 Loop Until Wb1.Name <> Wb2.Name
 Wb2.SaveAs Filename:=Chemin, FileFormat _
 :=xlOpenXMLWorkbook, CreateBackup:=False
  
  On Error Resume Next
  ActiveWindow.Close
 Set Wb1 = Nothing
 Set Wb2 = Nothing
  End Sub

 

[nomzamo]

Re : sauvegarder certaines feuilles sur un autre fichier

Bonsoir JP,
La macro marche nickel et en plus avec la gestion d'erreurs possible.
Merci beaucoup pour ton aide précieuse.
Cordialement,
Roger

 

[Si...]

Re : sauvegarder certaines feuilles sur un autre fichier

salut

Si la sauvegarde a lieu dans un autre dossier choisi grâce à la boîte de dialogue correspondante, il n'est pas utile de comparer les noms voilà pourquoi j'en étais resté là

Sub CopierOnglets()
  Dim Sh As Worksheet, Chemin As String, n As Byte
  Dim Moi As Workbook, Lui As Workbook
  Set Moi = ThisWorkbook:  Set Lui = Workbooks.Add
  'boîte de dialogue pour changer de Dossier  
  Chemin = Application.GetSaveAsFilename(, "Classeur Excel(*.xlsx),*.xlsx", , "Dossier de sauvegarde")
  If Chemin = "" Then Exit Sub
  For Each Sh In Moi.Worksheets
    If Sh.Name <> "Travail" And Sh.Name <> "Noms" And Sh.Name <> "Valeurs" Then
      n = n + 1: Sh.Copy Sheets(n)
    End If
  Next
  Lui.SaveAs Filename:=Chemin, FileFormat:=xlOpenXMLWorkbook
  ActiveWindow.Close
  Set Moi = Nothing: Set Lui = Nothing
End Sub

avec les mêmes désagréments : le message pour éviter les macros et les onglets obtenus à la création.

Remarque : si on sauvegarde dans le même répertoire, il n'est pas utile d'ouvrir la boîte de dialogue.

 

[nomzamo]

Re : sauvegarder certaines feuilles sur un autre fichier

Bonsoir et merci Si... pour cette autre solution.
Les 2 solutions fonctionnent très bien, par contre je viens de me rendre compte que dans les 2 cas si l'utilisateur clique sur le bouton "Annuler" de la boite de dialogue d'enregistrement on obtient un classeur nommé Faux.xlsx. Je ne crois pas qu'on puisse supprimer l'option "Annuler", comment peut-on faire pour ne pas avoir ce fichier?
Roger

 

[jpb388]

Re : sauvegarder certaines feuilles sur un autre fichier

re
Teste et dis moi

Sub CopierF()
  '
  ' Copier une feuille dans un autre classeur
  '
  Dim Feuille As Worksheet, Chemin$, Filtre$, Titre$, Nb%, FS$
  Dim Wb1 As Workbook, Wb2 As Workbook
  Set Wb1 = ThisWorkbook
  Set Wb2 = Workbooks.Add
  For Each Feuille In Wb1.Worksheets
      Select Case Feuille.Name 'on pourrait utiliser un if mais moi je préfère le select plus clair
          Case "Travail"
          Case "Noms"
          Case "Valeurs"
          Case Else
            Feuille.Copy After:=Wb2.Worksheets(Wb2.Worksheets.Count)
      End Select
  Next Feuille
  Do
 Filtre = "Fichier Excel(*.xlsx),*.xlsx"
 Titre = "Ou vou lez vous enregistrer vos feuilles?"
 Chemin = Application.GetSaveAsFilename(, Filtre, , Titre)
 If Chemin = "" Or Chemin = "Faux" Then GoTo Erreur
 If Wb1.Name = Wb2.Name Then MsgBox "Veuillez indiquer un nom différent du fichier source Merci", vbInformation + vbOKOnly, "Nom Identique"
 Loop Until Wb1.Name <> Wb2.Name
 Wb2.SaveAs Filename:=Chemin, FileFormat _
 :=xlOpenXMLWorkbook, CreateBackup:=False
Erreur:
  On Error Resume Next
  ActiveWindow.Close False
 Set Wb1 = Nothing
 Set Wb2 = Nothing
  End Sub

 

[Staple1600]

Re : sauvegarder certaines feuilles sur un autre fichier

Bonsoir à tous

Manuellement ,3 à 5 secondes suffisent pour:
1) Grouper les feuilles
2) Clic-droit Copier vers un nouveau classeur
3) et enfin Enregistrer sous

Mais bon apparemment il faut absolument passer par une macro a dit le demandeur 😉

 

[nomzamo]

Re : sauvegarder certaines feuilles sur un autre fichier

Bonjour JP,
Je viens de tester et c’est ok : je n’ai plus le classeur Faux.xlsx en sauvegarde sur le bouton « Annuler » de la boite de dialogue enregistrer sous. Merci pour ton aide précieuse, mon classeur est opérationnel maintenant.
De plus je viens d’apprendre grâce à Staple1600 que j’ai gagné 3 à 5 secondes 😀
Cordialement,
Roger

 

[Staple1600]

Re : sauvegarder certaines feuilles sur un autre fichier

Bonjour à tous

De plus je viens d’apprendre grâce à Staple1600 que j’ai gagné 3 à 5 secondes

Quoique...

Les 2 solutions fonctionnent très bien, par contre je viens de me rendre compte que dans les 2 cas si l'utilisateur clique sur le bouton "Annuler" de la boite de dialogue d'enregistrement on obtient un classeur nommé Faux.xlsx. Je ne crois pas qu'on puisse supprimer l'option "Annuler", comment peut-on faire pour ne pas avoir ce fichier?

La procédure manuelle évite cela car l'être humain en train de perdre 3 à 5 secondes pour sauvegarder 3 malheureuses feuilles sait que si il clique sur Annuler, il se se passera rien 😉.
La macro elle ne sait pas tout cela 😉

 

[Staple1600]

Re : sauvegarder certaines feuilles sur un autre fichier

Re

nomzamo
En tout cas , c'est sur que tu n'as pas essayé ma proposition en laissant tourner l’enregistreur de macros*. 😉
Car sinon...

Sub MacrotonsPuisquIlLeFaut()
Sheets(Array("Travail", "Noms", "Valeurs")).Copy 'ici c'est l'es 3/5 en manuel ;o)
ActiveWorkbook.SaveAs "C:\Temp\WhatEverYouWant.xlsx", 51, False
End Sub

Tu peux compléter avec la partie du code de Si... ou jpb388 qui appelle la boite de dialogue ou pas 😉

*: je te laisse tester avec l’enregistreur qui tourne pour avoir la version qui copie dans un autre classeur (déjà ouvert).

Petites questions:
• s'il s'agit d'une sauvegarde pourquoi ne pas définir le répertoire en dur dans le code (il n'y a aucune raison pour que le répertoire change) et cela évite le problème Annuler.
• donc si sauvegarde, la prochaine fois, tu réouvres ton classeur tu supprimes les 3 feuilles précédemment copiées et tu les remplaces par les 3 nouvelles feuilles Travail, Noms, Valeurs . (dans ce cas là, tu perds les anciennes versions)

Personnellement, si je dois sauver régulièrement des feuilles (et que j'ai la flemme de le faire manuellement), je procéderai ainsi (dans un premier temps)

Sub Sauvegarde()
Dim SVGPath$, FileNameT$
SVGPath = "C:\Temp\"
FileNameT = "svg" & Format(Date, "ddmmyyy") & ".xlsx"
Sheets(Array("Travail", "Noms", "Valeurs")).Copy
ActiveWorkbook.SaveAs SVGPath & FileNameT, 51, False
End Sub