Créer des nouveaux classeurs à partir d'onglets déjà existants

Messages postés
1
Date d'inscription
vendredi 13 septembre 2019
Statut
Membre
Dernière intervention
13 septembre 2019
-
Bonjour,

Je suis encore novice en programmation VBA mais j'essaie depuis hier de faire une manip, en vain.
J'ai un classeur avec une vingtaine d'onglets, et je souhaiterai créer un classeur par onglet, les enregistrer en les renommant selon la valeur dans la cellule A1, le fermer et passer au suivant.
Là où je bloque, c'est dans la boucle "For".

Voilà un aperçu de mon code :

 Sub CREATION_FICHIER_PAR_NUM()

    Sheets("onglet_1").Select
    Sheets("onglet_1").Copy

    ChDir _
        "C:\[...]\Inventaire "
    ActiveWorkbook.SaveAs Filename:= _
        "C:\[...]\Inventaire\Onglet1.xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    Application.WindowState = xlNormal
    ActiveWindow.Close
    
    Dim i As Integer

    For i = 1 To 20
    
    ActiveSheet.Next.Select
    ActiveSheet.Copy
    
    Dim Chemin As String, NomFichier As String
    Dim NomFichier As String
 
NomClasseur = Range("A1").Value

    Chemin =  "C:\[...]\Inventaire\Onglet1.xlsm"
    NomFichier = NomClasseur & ".xlsm"
    ThisWorkbook.SaveAs Chemin & NomFichier, FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    ActiveWindows.Close True
    
    i = i + 1
 
Next

End Sub 


C'est à la fin que ça bloque, en fait il ne veut pas enregistrer mon nouveau classeur et le fermer, je ne comprends pas pourquoi.

Merci d'avance pour votre aide et bonne fin de semaine à tous les valeureux travailleurs !
EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI

Merci d'y penser dans tes prochains messages.
Afficher la suite 

1 réponse

Messages postés
8513
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
13 septembre 2019
422
0
Merci
bonjour, peux-tu être plus précis?
as-tu un message d'erreur? sur quelle ligne?
je suggère ceci:
Dim fl As Worksheet, nouv As Workbook
For Each fl In ThisWorkbook.Sheets
    Set nouv = Application.Workbooks.Add
    Call fl.Copy(nouv.Sheets(1))
    nouv.SaveAs (ThisWorkbook.Path + "\" + fl.[A1] + ".xlsx")
    nouv.Close
Next fl
Commenter la réponse de yg_be