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

Signaler
Messages postés
1
Date d'inscription
vendredi 13 septembre 2019
Statut
Membre
Dernière intervention
13 septembre 2019
-
Messages postés
12294
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
22 septembre 2020
-
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.

1 réponse

Messages postés
12294
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
22 septembre 2020
694
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