Boucle pour copier cellules d'un classeur à un nouveau

Bonjour,

j'ai un classeur avec des données, je souhaite créer une boucle permettant de copier le contenu de chaque feuille vers un nouveau classeur (avec la possibilité d'enregistrer le classeur nouveau dans un endroit déterminé et avec un nom prédéfini.

J'ai essayé ça par moi même

For Each feuil In ThisWorkbook.Worksheets
        feuil.Activate
        feuil.Copy
        Workbooks.Add
        ActiveSheet.Paste
    Next feuil

End Sub

Problème j'ai autant de classeur que de feuilles...

EDIT: J'ai trouvé en partie ma solution:

Sub Macro1()
   lieu_rec = ActiveWorkbook.Path
   Sheets("suivi_sarah").Copy
    Sheets("suivi_toto").Select
    Sheets("suivi_toto").Copy
    With ActiveWorkbook
     .Title = "oulouloulou"

     .SaveAs Filename:=lieu_rec + "\oulouloulou" + ActiveSheet.Name + ".xls"
    End With
End Sub

ça fonctionne pour la première mais pas la deuxième :

Dimension spécifiée non valide pour le type de graphique en cours

Cordialement,

Bonjour

Essaie ce code :

Sub ess()
    Set wS = ActiveWorkbook
    Workbooks.Add
    Set wD = ActiveWorkbook
    For Each feuil In wS.Worksheets
        feuil.Copy Before:=wD.Sheets(1)
        wS.Activate
    Next feuil
End Sub

Bye !

Gmd j'ai adapté mon code et le tien et ça fonctionne mille merci !

   Sub ess()
      chemin = ActiveWorkbook.Path
    Set feuil = Worksheets

        Set wS = ActiveWorkbook
        Workbooks.Add
        Set wd = ActiveWorkbook
        For Each feuil In wS.Worksheets
            feuil.Copy Before:=wd.Sheets(1)
            wS.Activate
        Next feuil
        wd.SaveAs Filename:=chemin + "\suivi_activité" + ".xls"
    End Sub

Pour éviter le double poste, je me permet d'insérer ma nouvelle requête ici étant donnée que c'est quasiment la même question.

Donc comme je le disais au dessus ça fonctionne. Sauf que ce fichier, via un fichier vbs et .bat doit s'envoyer par mail. Sauf que la copie que je réalise est trop lourde pour l'envoie.

La solution que je souhaite est donc : copie d'une plage de cellule de chaque feuille dans un nouveau classeur excel

Ce qui me permettrait d'avoir un fichier assez léger, j'ai tester ce code :

Application.DisplayAlerts = False
Application.ScreenUpdating = false

chemin = ActiveWorkbook.Path
    Set feuil = Worksheets

        Set ws = ActiveWorkbook
        Set plage = Range("a1:p350")

        Workbooks.Add
        Set wd = ActiveWorkbook
        For Each feuil In ws.Worksheets
        ws.feuil.plage.Select ' cette ligne pose problème

    plage.Copy Before:=wd.Sheets(1)
            ws.Activate
        Next feuil
        wd.SaveAs Filename:=chemin + "\suivi" + ".xls", FileFormat:=xlNormal
        wd.Sheets(3).Delete
        wd.Sheets(4).Delete
       ' wd.Close
      Application.DisplayAlerts = True
Application.ScreenUpdating = true

Mais ça ne fonctionne pas erreur au niveau de la sélection : ws.feuil.plage.Select.

Je sais pas si je suis très claire :/

J'espère réellement que une âme charitable va pouvoir me donner un coup de main^^ Parce que je sais que c'est assez basique comme macro mais c'est le seul truck qui me manque pour que mon outil soit complet

Bonjour

Jean351601 a écrit :

ws.feuil.plage.Select ' cette ligne pose problème

Essaie en remplaçant "plage" par sa définition :

ws.feuil.Range("a1:p350").Select 

Bye !

Erf

la méthode select range à échoué avec:

feuil.Range("a1:p350").Select

  feuil.Copy Before:=wd.Sheets(1)
            ws.Activate
        Next feuil

et propriété ou méthode non géré par cet objet avec ça:

   Set feuil = Worksheets

        Set ws = ActiveWorkbook
        Set plage = Range("a1:p350")

        Workbooks.Add
        Set wd = ActiveWorkbook
        For Each feuil In ws.Worksheets
        ws.feuil.Range("a1:p350").Select

plage.Copy Before:=wd.Sheets(1)
            ws.Activate
        Next feuil

J'ai aussi tenté de cette manière

  For Each feuil In ws.Worksheets

             Cells.Select
           Selection.Copy Before:=wd.Sheets(1)
            ws.Activate
        Next feuil

Mais la ça coince aussi

Essaie ce code :

Sub Exporter()

    Application.ScreenUpdating = False
    chemin = ActiveWorkbook.Path
    Set fdep = ActiveSheet
    Set ws = ActiveWorkbook
    Workbooks.Add
    Set wd = ActiveWorkbook
    For Each feuil In ws.Worksheets
        wd.Sheets.Add before:=ActiveSheet
        Set f = wd.ActiveSheet
        ws.Activate
        feuil.Range("a1:p350").Copy f.Range("A1")
    Next feuil
    wd.SaveAs Filename:=chemin + "\suivi" + ".xls", FileFormat:=xlNormal
    wd.Close
    fdep.Select
End Sub

Bye !

Je te remercie car encore une fois en mélangeant ton code et le mien j'ai réussi

Attention la boucle que tu as mis en place est cependant très lourde !