XL 2010 Enregistrer seulement quelques feuilles d'un classeur

Sub ExempleCopieFeuilles()
For Each ws In Sheets(Array("Feuil1", "Feuil3", "Feuil5"))
  ws.Copy
  ch = ThisWorkbook.Path & "\" & ws.Name & ".xlsx"
  ActiveWorkbook.SaveAs ch
Next
End Su

Sub sauvegarder()

' Noms des feuilles à sauvegarder
Const MesFeuilles = "DR 02,DR 03,DT 08,DT 05,EBR"

' chemin complet de sauvegarde -> ex: "C:\toto"
' si vide alors le dossier de sauvegarde est le dossier de ce fichier
Const MonDossier = ""

' si Tout = True, on copie chaque feuille dans son intégralité
' si Tout = False, on ne copie que les valeurs et les mises en forme
Const Tout = False

Dim TabloMesFeuilles, MonChemin, elem

  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  TabloMesFeuilles = Split(MesFeuilles, ",")
  If MonDossier = "" Then MonChemin = ThisWorkbook.Path Else MonChemin = MonDossier
  If Right(MonChemin, 1) <> "\" Then MonChemin = MonChemin & "\"
  
  For Each elem In TabloMesFeuilles
    Sheets(elem).Copy
    If Tout = False Then
      ThisWorkbook.Sheets(elem).Cells.Copy
      ActiveWorkbook.ActiveSheet.Cells.PasteSpecial xlPasteFormats
      ActiveWorkbook.ActiveSheet.Cells.PasteSpecial xlPasteValues
    End If
    ActiveWorkbook.SaveAs MonChemin & elem, xlOpenXMLWorkbookMacroEnabled
    ActiveWorkbook.Close
  Next elem

Erreur:
  Application.DisplayAlerts = True
End Sub

Sub Copie_TCD_ValForm_Vers_Feuil(xTCD, yFeuilCible As Worksheet)

'----------------------------------------------------------------------------------------
' Copie du TCD "xTCD" vers la feuille "yFeuilCible"
' On ne copie que les valeurs et les formats du TCD
' Le TCD copié est au même emplacement que le TCD source "xTCD"
'
' Basé sur le code déniché sur le site: [url=http://www.contextures.com/]Contextures Website - Excel Tips, Excel Tutorials and Excel Examples[/url]
' à la page: [url=http://www.contextures.com/excel-vba-pivot-table-paste-format.html#PasteCode]Excel VBA Pivot Table Paste Format and Values[/url]
'----------------------------------------------------------------------------------------

Dim xrgZonepDePage As Range, xrgZoneData1 As Range, NligZoneData1 As Long

Application.ScreenUpdating = False
'------ recherche de la zone de page du TCD et copie ------
On Error Resume Next    ' si pas de champ page, on passe...
Set xrgZonepDePage = xTCD.PageRange
If Err = 0 Then
  ' si pas d'erreur -> on copie la zone de page du TCD
  Err.Clear: On Error GoTo FIN_ERREUR
  ' on copie la zone de page du TCD
  xrgZonepDePage.Copy yFeuilCible.Range(xrgZonepDePage.Address)
Else
  On Error GoTo FIN_ERREUR
End If

'------ copie du TCD sans la zone de page ------
Set xrgZoneData1 = xTCD.TableRange1     'la zone
NligZoneData1 = xrgZoneData1.Rows.Count ' le nombre de ligne de cette zone

'copie de la zone sans la dernière ligne
xrgZoneData1.Resize(NligZoneData1 - 1).Copy yFeuilCible.Range(xrgZoneData1.Address)

'copie de la zone (uniquement la dernière ligne)
xrgZoneData1.Resize(1).Offset(NligZoneData1 - 1).Copy _
    yFeuilCible.Range(xrgZoneData1.Resize(1).Offset(NligZoneData1 - 1).Address)

'copie des largeurs de colonnes
xrgZoneData1.EntireColumn.Copy
yFeuilCible.Range(xrgZoneData1.Address).EntireColumn.PasteSpecial xlPasteColumnWidths
Application.CutCopyMode = False
Exit Sub

FIN_ERREUR:
  MsgBox "Erreur n° " & Err.Number & " : " & Err.Description, vbCritical
  MsgBox "Echec de la copie du TCD : " & xTCD.Name, vbCritical
End Sub