XL 2016 Base puis création de fichiers multiples sous une présentation similaire

Julie-F

XLDnaute Occasionnel
Bonjour la Team,

Je dispose d'un fichier Excel comprenant 2 onglets (1 onglet : base et 1 onglet : template)
Je voudrais savoir s'il était possible de créer autant de fichiers sous un même modèle (template) que la base contient de ligne de façon automatisée (plus de 1500 lignes sur la base originelle) ?
Chaque fichier ainsi créé devra être nommé en reprenant le texte contenu dans les cellules suivantes du fichier : O1 - C4 - E1. J'ignore si dans le cas du "nom de fichier" il est plus facile d'opter pour les cellules contenues dans le(s) fichier(s) créé(s) ou s'il est préférable de partir de l'onglet "base" ?
Je vous joins un extrait de fichier en souhaitant que ma recherche soit plus explicite.

Je vous remercie par avance de toute l'aide que vous pourrez m'apporter sur ce projet.

Bonne journée à tous
 

Pièces jointes

  • Base et template.xlsx
    18.4 KB · Affichages: 5
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Julie,
Un essai en PJ avec :
VB:
Sub Enregistre()
Application.ScreenUpdating = False
Chemin = ThisWorkbook.Path & "\"
Set Base = Sheets("Base")
Sheets("Template").Select
T0 = Timer: DL = Base.[A10000].End(xlUp).Row
For L = 2 To DL
    [E1] = Base.Cells(L, "D"): [O1] = Base.Cells(L, "A")
    [C4] = Base.Cells(L, "I"): [D5] = Base.Cells(L, "H")
    [P4] = Base.Cells(L, "E"): [E3] = Base.Cells(L, "F")
    With ActiveWorkbook
        NomFichier = Chemin & [O1] & "_" & [C4] & "_" & [E1] & ".xlsx"
        Application.DisplayAlerts = False
        ThisWorkbook.Worksheets("TEMPLATE").Copy
        ActiveWorkbook.SaveAs NomFichier
        ActiveWorkbook.Close True
        Application.DisplayAlerts = True
    End With
    Application.StatusBar = "Fichier N° " & (L - 1) & " - Progression : " & Format(L / (DL - 1), "0%") & " - Temps écoulé : " & Format(Timer - T0, "0.000s")
Next L
Application.StatusBar = ""
Sheets("Base").Select
End Sub

Je pense qu'en E3 il faut mettre non pas E3 de Base mais F2.

A tester avec juste quelques fichiers car les traitements sont assez longs.
 

Pièces jointes

  • Base et template.xlsm
    28.6 KB · Affichages: 4

Julie-F

XLDnaute Occasionnel
Bonjour Sylvanu

C'est vraiment super ... Merci beaucoup 😍
C'est en P4 que je me suis trompée mais j'ai rectifié.
Ce n'était pas trop compliqué.

A nouveau un grand MERCI A TOI ....
Bonne fin de journée
 
Dernière édition:

Julie-F

XLDnaute Occasionnel
Bonjour Sylvanu

Je reviens vers toi pour une question supplémentaire.
Les fichiers créés depuis "Template" fonctionnent à merveille et reprennent à l'identique le formalisme.

Ma question est la suivant :

Sachant que la feuille du template est protégée (avec ou sans mot de passe) et qu'il convient de ne pas verrouiller les cellules sur fond jaune afin que celles-ci puissent être renseignées, est -il possible d’insérer en fin d’exécution de la macro :
1. ôter la protection de la feuille
2. Pour les cellules sur fond jaune : format cellule protection verrouillée
3. Protéger la feuille avec l'option : sélectionner les cellules déverrouillées.

J'ai écrit ceci apres "ThisWorkbook.Worksheets("Poste").Copy" et cela fonctionne mais cela ne me parait pas être un code très harmonieux.
Merci d'avance pour ton éclairage précieux


VB:
 ThisWorkbook.Worksheets("Poste").Copy
        Sheets("Poste").Select
        ActiveSheet.Unprotect
        Range("E1:H1").Select
        Selection.Locked = True
        Selection.FormulaHidden = False
        Range("O1:S1").Select
        Selection.Locked = True
        Selection.FormulaHidden = False
        Range("E3:S3").Select
        Selection.Locked = True
        Selection.FormulaHidden = False
        Range("C4:R4").Select
        Selection.Locked = True
        Selection.FormulaHidden = False
        Range("D5").Select
        Selection.Locked = True
        Selection.FormulaHidden = False
        Range("P5").Select
        Selection.Locked = True
        Selection.FormulaHidden = False
      ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False
    ActiveWorkbook.SaveAs NomFichier
 
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Julie,
Pas trop bien compris. Je suppose que c'est un "morceau" de macro sinon à quoi sert le "copy" et NomFichier non défini. :)
Sinon, ex abrupto, je pense que vous pouvez simplifiez ainsi :
VB:
    ThisWorkbook.Worksheets("Poste").Copy
    Sheets("Poste").Select
    ActiveSheet.Unprotect
    Range("E1:H1,O1:S1,E3:S3,C4:R4,D5,P5").Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
    ActiveWorkbook.SaveAs NomFichier
 

Julie-F

XLDnaute Occasionnel
Bonjour Julie,
Pas trop bien compris. Je suppose que c'est un "morceau" de macro sinon à quoi sert le "copy" et NomFichier non défini. :)
Sinon, ex abrupto, je pense que vous pouvez simplifiez ainsi :
VB:
    ThisWorkbook.Worksheets("Poste").Copy
    Sheets("Poste").Select
    ActiveSheet.Unprotect
    Range("E1:H1,O1:S1,E3:S3,C4:R4,D5,P5").Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
    ActiveWorkbook.SaveAs NomFichier
Bonsoir Sylvanu

ThisWorkbook.Worksheets("Poste").Copy est la ligne de code de ta macro à partir de laquelle j'ai inséré le mien (fort mal écrit par la néophyte que je suis 🥴 )
ActiveWorkbook.SaveAs NomFichier étant à nouveau la ligne de code de ta macro.

Merci beaucoup pour la simplification proposée ... écriture bien plus glamour que mes lignes successives proche d'une liste à la Prévert.

Bonne soirée Sylvanu
 

Discussions similaires

Statistiques des forums

Discussions
315 126
Messages
2 116 490
Membres
112 763
dernier inscrit
issam2020