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

Fermé
jojodu78 Messages postés 1 Date d'inscription vendredi 13 septembre 2019 Statut Membre Dernière intervention 13 septembre 2019 - Modifié le 13 sept. 2019 à 14:23
yg_be Messages postés 22717 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 22 avril 2024 - 13 sept. 2019 à 14:39
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.
A voir également:

1 réponse

yg_be Messages postés 22717 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 22 avril 2024 1 476
Modifié le 13 sept. 2019 à 14:50
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
0