Créer un classeur par feuille

[FaridP]

Bonjour à toutes et à tous,

J'essaie de créer un classeur pour chacune des feuilles de mon document mais les fichiers créés sont vides, je ne vois pas ce qui cloche dans mon code car je suis passé par l'enregistreur de macros, pourriez-vous m'aider ou me mettre sur la voie ?

Sub CreateFic()

Dim Ws As Worksheet
Dim NomFic As String
Application.DisplayAlerts = False

For Each Ws In ThisWorkbook.Worksheets

NomFic = Ws.Name

    Cells.Copy
    Workbooks.Add
    Cells.Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ChDir "C:\Test"
    ActiveWorkbook.SaveAs Filename:="C:\Test\" & NomFic & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
  
Next Ws

Application.DisplayAlerts = True

End Sub

Merci pour votre aide et bonne fin de journée,

Farid 🙂😉

 

[Dranreb]

Bonjour.
Essayez comme ça :

Sub CreateFic()
Dim Wsh As Worksheet
ChDrive "C": ChDir "C:\Test"
For Each Wsh In ThisWorkbook.Worksheets
   Workbooks.Add
   Wsh.Cells.Copy Destination:=ActiveSheet.[A1]
   ActiveWorkbook.SaveAs Filename:=Wsh.Name & ".xlsx", _
      FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
   ActiveWorkbook.Close SaveChanges:=True
   Next Wsh
End Sub

 

[FaridP]

Bonjour Dranreb,

Même résultat : les classeurs créés sont vides. 🙁

Est-ce dû au fait que ce soient des tableaux ?

Merci,

Farid

 

[Dranreb]

Supprimez vos anciens classeurs. Je suis en effet fondé à supposer que vous ouvrez des classeurs issus d'essais précédents, le code écrit comme ça les écrivant ailleurs que là où vous croyez.

 

[FaridP]

Je viens d'essayer depuis un autre poste sur lequel les classeurs n'avaient jamais été créés et même résultat : fichier vide. 🙁

Par acquis de conscience, j'ai même testé avec un nouveau classeur contenant uniquement 1 ligne de données et pareil.

 

[Dranreb]

Alors je ne vois pas, si on excepte bien sûr la possibilité que toutes les feuilles du classeur portant la macro soient vides.
Normalement ça devrait marcher.

 

[FaridP]

Non, elles contiennent toutes des données (sous la forme d'un tableau).
C'est bien ma chance ça. :'(

Merci pour votre aide en tout cas.

Farid

 

[Dranreb]

Par acquis de conscience, j'ai même testé avec un nouveau classeur contenant uniquement 1 ligne de données et pareil.

Était-il bien équipé de la macro au moins ? ThisWorkbook c'est le classeur qui porte la macro, et non celui qui est actif au moment de son lancement. Ce dernier c'est ActiveWorkbook.

 

[FaridP]

Était-il bien équipé de la macro au moins ? ThisWorkbook c'est le classeur qui porte la macro, et non celui qui est actif au moment de son lancement. Ce dernier c'est ActiveWorkbook.

Oui, je l'y avais copiée.

 

[Dranreb]

Joignez le, on ne sait jamais.

 

[FaridP]

C'est bon, j'ai réussi en modifiant très légèrement le code ! 😀

Sub CreateFic()

Dim Wsh As Worksheet
ChDrive "C": ChDir "C:\Test"

For Each Wsh In ThisWorkbook.Worksheets
   
    Wsh.Copy
    ActiveWorkbook.SaveAs Filename:=Wsh.Name & ".xlsx", _
      FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close SaveChanges:=True

Next Wsh

End Sub

Merci beaucoup car sans votre aide, je serais bon pour le faire à la main. 😉🙂