Exporter plusieurs feuilles d'un classeur Excel en Excel séparé

Bonjour,

J'ai un fichier avec plus d'une vingtaine de feuilles.

Je souhaite à l'aide d'une macro,exporter séparemment certains onglets de mon classeur dans un format excel. Chacunes des feuilles exportées doit être enregistré dans un emplacement que je choisis ou dans le même dossier que le classeur principal. Les feuilles enregistrées également doivent garder le nom de l'onglet.

(toutes les feuilles de mon classeur, ne devront pas être exportés. Les Feuilles qui ne seront pas exportés sont les mêmes à chaque utilisation de l'outil : Menu, Import, Paramètres, Traitement. Toutes les autres seront exportées)

Quelqu'un pourrait il m'aider svp.

Merci

Bonjour,

Il est possible de partir d'ici https://www.excel-pratique.com/fr/telechargements/utilitaires/dispatcher-compiler-excel-no466 et l'adapter assez facilement à des onglets multiples.

Pour cela, il faudrait avoir une maquette de fichier de ta part ...

Bonjour Steelson

Merci pour ta réponse et pour ton aide. Ci-joint un fichier. Pour résumer :

Les feuilles qui ne seront jamais exportées: Menu,Import,Traitement,Paramètres

Les feuilles à exporter dans un format excel:

- Analyse Globale,Répartition par entité, Parc à remplacer : doivent être enregistrées ensemble dans le même fichier sous le nom Analyse Globale

- Les feuilles: Alpes, Corse, Ile de france, charentes, Pyrenées, Var, Cote d'azur, Finistère : sont à exportées séparement chacune. Le nom ne chaque fichier sera celui de l'onglet.

J'espère que tu pourras m'aider.

Merci encore à toi.

Muqtadir92 a écrit :

- Les feuilles: Alpes, Corse, Ile de france, charentes, Pyrenées, Var, Cote d'azur, Finistère : sont à exportées séparement chacune. Le nom ne chaque fichier sera celui de l'onglet.

1er point ...

Sub exporter()
Dim f As Worksheet
Dim xl As Excel.Application, wb As Excel.Workbook
Dim MonRepertoire, Repertoire As FileDialog

    feuilles = Array("Alpes", "Corse", "Ile de france", "Charentes", "Pyrenées", "Val", "Cote d'azur", "Finistère")

    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage des fichiers générés"
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit Sub
    MonRepertoire = Repertoire.SelectedItems(1)

    Set xl = CreateObject("Excel.Application")
    xl.SheetsInNewWorkbook = 1

    For i = 0 To UBound(feuilles)
        Set f = Sheets(feuilles(i))
        f.Cells.Copy
        Debug.Print f.Name, f.Range("A1")
        Set wb = xl.Workbooks.Add
        wb.Sheets(1).Paste
        wb.SaveAs (MonRepertoire & "\" & f.Name & ".xlsx")
        wb.Close
        Set wb = Nothing
    Next
    xl.Quit
    Set xl = Nothing
    MsgBox "Terminé !"

End Sub

et avec ceci

Muqtadir92 a écrit :

- Analyse Globale,Répartition par entité, Parc à remplacer : doivent être enregistrées ensemble dans le même fichier sous le nom Analyse Globale

Sub exporter()
Dim f As Worksheet
Dim xl As Excel.Application, wb As Excel.Workbook, ws As Excel.Worksheet
Dim MonRepertoire, Repertoire As FileDialog

' paramètres #############
feuilles = Array("Alpes", "Corse", "Ile de france", "Charentes", "Pyrenées", "Val", "Cote d'azur", "Finistère")

    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage des fichiers générés"
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit Sub
    MonRepertoire = Repertoire.SelectedItems(1)

    Set xl = CreateObject("Excel.Application")
    xl.SheetsInNewWorkbook = 1

    For i = 0 To UBound(feuilles)
        Set f = Sheets(feuilles(i))
        f.Cells.Copy
        Set wb = xl.Workbooks.Add
        wb.Sheets(1).Paste
        wb.SaveAs (MonRepertoire & "\" & f.Name & ".xlsx")
        wb.Close
        Set wb = Nothing
    Next

' paramètres #############
feuilles = Array("Analyse Globale", "Répartition par entité", "Parc à remplacer")

    Set wb = xl.Workbooks.Add
    For i = 0 To UBound(feuilles)
        Set f = Sheets(feuilles(i))
        Debug.Print f.Name
        f.Cells.Copy
        With wb
            If i > 0 Then .Worksheets.Add After:=.Worksheets(.Worksheets.Count)
            .Sheets(i + 1).Paste
            .Sheets(i + 1).Name = feuilles(i)
        End With
    Next
    wb.SaveAs (MonRepertoire & "\" & feuilles(0) & ".xlsx")
    wb.Close
    Set wb = Nothing

    xl.Quit
    Set xl = Nothing
    MsgBox "Terminé !"

End Sub

Merci à toi Steelson. Vraiment merci. Tu gères.

ça marche très bien.