Création d'autant ce fichiers que de feuilles

Bonsoir le forum

Voilà, j'ai une macro qui me permet de créer autant de fichiers que d'onglet contenu dans un autre fichier.

Ca fonctionne, mais je cherche à inclure lors de la création des fichiers une copie de la première feuille contenu

dans le fichier et que les fichiers soient créés dans un dossier que je pourrai choisir

Sub EclaterClasseur()

For Each Feuille In ActiveWorkbook.Sheets

    Feuille.Copy

    With ActiveWorkbook

        .Title = Feuille.Name

        .Subject = Feuille.Name

        .SaveAs Filename:=Feuille.Name + ".xls"

    End With

Next

End Sub

Merci pour votre aide et pour votre disponibilité

En faite je cherche à faire simplement

Classeur d'origine : Feuil1, Feuil2, Feuil3, Feuil4

Classeurs à créer : Feuil1 et Feuil2, Feuil1 et Feuil3, Feuil1 et Feuil4

Le tout s'enregistrant Feuil2, Feuil3, Feuil4 dans uns dossier que je choisis par le biais de la commande save as

Bonjour

Essaie ce code :

Sub essai()
    For Each feuille In Worksheets
        Sheets("Feuil1").Copy
        Set w = ActiveWorkbook
        Windows("Original.xlsm").Activate
        feuille.Copy After:=w.Sheets(1)
        w.Activate

        fichier = Application.GetSaveAsFilename(feuille.Name, filefilter:="Fichier(*.xls),*.xls")
        ActiveWorkbook.SaveAs Filename:=fichier
        ActiveWindow.Close
     Next feuille
    MsgBox "Travail terminé"
End Sub

Bye !

Bonsoir gmb

merci pour ton aide

j'ai été obligé de commenter

'Windows("Original.xlsm").Activate

car ça beuguait

C'est super ça fonctionne, par contre la macro passe feuille par feuille, est-il possible de n'avoir qu'une seule fois la commande

Application.GetSaveAsFilename

pour tous les fichiers d'un seul coup, Je lance la macro, je choisi mon dossier et tous

les fichiers se créent d'un seul coup, parce si il y a 62 onglets ...

merci pour ton aide et ta disponibilité

Rechercher des sujets similaires à "creation autant fichiers que feuilles"