Enregistrer séparément tous les onglets d'un fichier

[Marianne]

Bonjour,

J'ai un fichier excel comportant environ 20 onglets. Chacun étant le suivi budgétaire propre à un responsable et chacun d'eux devant avoir accès à son fichier sans voir les autres.
Je souhaiterais donc séparer automatiquement tous les onglets et les enregistrer dans le répertoire d'origine avec comme nom celui de l'onglet.

J'ai essayé avec le code suivant :

Private Sub CommandButton1_Click()
Dim CheminRep, Ws As Worksheet

For Each Ws In Worksheets ' Collection des feuilles du classeur
If Ws.Name <> "Accueil" Then ' Non enregistrement de la feuille Accueil
CheminRep = ActiveWorkbook.Path & "\" ' ou chemin du répertoire du classeur actif
Application.DisplayAlerts = False ' Désactivation des messages d'alerte
Ws.Copy ' Création d'un classeur avec une feuille
ActiveWorkbook.SaveAs Filename:=CheminRep & Ws.Name & ".xls" ' Enregistrement avec le nom de la feuille
Application.DisplayAlerts = True
ActiveWorkbook.Close ' Fermeture du classeur
End If
Next Ws
End Sub

ça semble avoir fonctionné pour le 1er onglet mais j'ai ensuite une "erreur d'éxécution1004" avec la partie "Ws.Copy ' Création d'un classeur avec une feuille" surlignée en jaune.

Quelqu'un peut il m'aider à comprendre ce qui ne va pas avec cette macro...ou m'indiquer un autre moyen ?

Je vous remercie par avance.

M

 

[MJ13]

Re : Enregistrer séparément tous les onglets d'un fichier

Bonjour Marianne

Essaye ainsi (j'ai juste rajouté Ws.Select):

Merci pour le code .

Sub Sépare_Sauve_Feuilles_Classeur()
Dim CheminRep, Ws As Worksheet
For Each Ws In Worksheets ' Collection des feuilles du classeur
Ws.Select
If Ws.Name <> "Accueil" Then ' Non enregistrement de la feuille Accueil
CheminRep = ActiveWorkbook.Path & "\" ' ou chemin du répertoire du classeur actif
Application.DisplayAlerts = False ' Désactivation des messages d'alerte
Ws.Copy ' Création d'un classeur avec une feuille
ActiveWorkbook.SaveAs Filename:=CheminRep & Ws.Name & ".xls" ' Enregistrement avec le nom de la feuille
Application.DisplayAlerts = True
ActiveWorkbook.Close ' Fermeture du classeur
End If
Next Ws
End Sub

 

[Dranreb]

Re : Enregistrer séparément tous les onglets d'un fichier

Bonjour.
Il est bon de toujours qualifier les propriétés.

For Each Ws In ThisWorkbook.Worksheets

Par défaut il prend ActiveWorkbook, lequel change tout le temps pendant le traitement !
À+

 

[Marianne]

Re : Enregistrer séparément tous les onglets d'un fichier

Merci pour ces réponses...mais malheureusement ça ne fonctionne toujours pas...seul le 1er onglet est bien copié et enregistré en tant que fichier...mais j'ai toujours la mêle "erreur d'éxécution1004" avec la partie "Ws.Copy ' Création d'un classeur avec une feuille" surlignée en jaune....

 

[Dranreb]

Re : Enregistrer séparément tous les onglets d'un fichier

Mettez un espion sur Ws et regardez les propriétés, là je ne sais pas. Protection scénarios ?... Sais pas.

La feuille est copiée quand même ou pas ? Les formules sont calculables dans le nouveau classeur ?
Sans voir le classeur qui reproduit le problème difficile à voir.

 

[kiki29]

Re : Enregistrer séparément tous les onglets d'un fichier

Salut,cela reste à adapter : ici sauvegarde de toutes les feuilles en XLSX dans un dossier yyyymmdd

Option Explicit

Sub Decoupage_2007()
Dim Wbk As Object
Dim Fso As Object
Dim sDossierClasseur As String, sNomDossier As String, sNomFichier As String
Dim Ws As Worksheet

    Application.ScreenUpdating = False
    sDossierClasseur = ThisWorkbook.Path
    sNomDossier = Format(Date, "yyyymmdd")

    Set Fso = CreateObject("Scripting.FileSystemObject")
    If Fso.FolderExists(sDossierClasseur & "\" & sNomDossier) Then
        Fso.DeleteFolder sDossierClasseur & "\" & sNomDossier, True
    End If
    Fso.CreateFolder sDossierClasseur & "\" & sNomDossier
    Set Fso = Nothing
        
    For Each Ws In ThisWorkbook.Worksheets
        sNomFichier = "F_" & Ws.Name & "_" & Format(Date, "yyyymmdd") & ".xlsx"

        ThisWorkbook.Worksheets(Ws.Name).Copy
        
        Set Wbk = ActiveWorkbook
        Application.DisplayAlerts = False
        
        Wbk.SaveAs sDossierClasseur & "\" & sNomDossier & "\" & sNomFichier, xlOpenXMLWorkbook
        Application.DisplayAlerts = True

        Wbk.Close
        Set Wbk = Nothing
    Next Ws
    Application.ScreenUpdating = True
End Sub