sauvegarder certaines feuilles sur un autre fichier

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

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

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

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

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

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

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