Création de feuilles à partir d'un modèle

Océane

XLDnaute Impliqué
Bonjour le forum
j'ai besoin de réaliser 2 macro:
MACRO 1
A partir de la feuille "tableau de bord", exécuter une Macro qui créera autant de feuilles que de lignes renseignées, (voir fichier joint) en copiant
la feuille "modèle",et en les renommant "F1" pour Dupont."F2" pour Duchemin...etc...
Recopier dans chaque nouvelle feuille les champs : Fiche N°, Nom, Prénom, Date de naissance, issues de la feuille "tableau de bord".

A partir de là, imprimer les feuilles; renseigner manuellement les champs restés vierges, puis les saisir pour réaliser les calculs . La formule égal, devrait
rapatrier les champs à collationner dans la feuille "Tableau de bord".
MACRO 2
Son exécution supprimera toutes les feuilles crées par la macro 1

Merci d'avance
 

Pièces jointes

  • FicheAtelier .xlsx
    27.7 KB · Affichages: 52

JCGL

XLDnaute Barbatruc
Bonjour à tous,

Peux-tu essayer ceci après avoir posé en E7 de Data et vers le bas :

Code:
=SI(D7="";"";SIERREUR(ENT((AUJOURDHUI()-D7)/365.45);""))

VB:
Option Explicit

Sub Création()
    Dim Lig&, DerL&
    DerL = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    For Lig = 7 To DerL
        Feuil2.Copy After:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = Feuil1.Range("A" & Lig)
            Range("C2") = Feuil1.Range("A" & Lig)
            Range("I3") = Format(Feuil1.Range("D" & Lig), "yyyy")
            Range("K3") = Feuil1.Range("E" & Lig)
            .PrintPreview
        End With
    Next Lig
End Sub

A+ à tous
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonjour à tous

Une proposition pour la MACRO1
VB:
Sub MACRO1()
Dim Dl&, i&, f As Worksheet
Set f = Sheets("tableau De Bord")
Dl = f.Cells(Rows.Count, 1).End(xlUp).Row
f.Activate
On Error Resume Next
For i = 7 To Dl
Sheets("modele").Copy after:=Sheets(Sheets.Count)
With ActiveSheet
.Range("C2") = Right(f.Cells(i, "A"), 1)
.Name = f.Cells(i, 1)
.Range("J1:J2") = Application.Transpose(Array(f.Cells(i, "B"), f.Cells(i, "C")))
.Range("I3") = Year(f.Cells(i, "D"))
End With
Next
End Sub

EDITION: Bonjour JCGL, je n'avais pas vu ta proposition avant de poster.
Désolé pour le télescopage.
 

JCGL

XLDnaute Barbatruc
Bonjour à tous,
Salut l'Agrafe,

VB:
Option Explicit

Sub Création()
    Dim Lig&, DerL&
    DerL = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = 0
    For Lig = 7 To DerL
        Feuil2.Copy After:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = Feuil1.Range("A" & Lig)
            Range("C2") = Feuil1.Range("A" & Lig)
            Range("I3") = Format(Feuil1.Range("D" & Lig), "yyyy")
            Range("K3") = Feuil1.Range("E" & Lig)
            .PrintOut
        End With
    Next Lig
    Feuil1.Activate
End Sub

Sub Report()
    Dim Lig&, DerL&
    DerL = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    For Lig = 7 To DerL
        With Feuil1
            On Error Resume Next
            Range("F" & Lig) = "=" & Range("A" & Lig).Value & "!K29"
            Range("G" & Lig) = "=" & Range("A" & Lig).Value & "!K68"
            Range("H" & Lig) = "=" & Range("A" & Lig).Value & "!K81"
            Range("I" & Lig) = "=" & Range("A" & Lig).Value & "!K93"
            Range("J" & Lig) = "=" & Range("A" & Lig).Value & "!K100"
            Range("K" & Lig) = "=" & Range("A" & Lig).Value & "!K106"
            Range("L" & Lig) = "=" & Range("A" & Lig).Value & "!K116"
            Range("M" & Lig) = "=" & Range("A" & Lig).Value & "!K125"
            Range("N" & Lig) = "=" & Range("A" & Lig).Value & "!K134"
            Range("F" & Lig & ":N" & Lig).Select
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues
            Application.DisplayAlerts = 0
            Sheets("F" & Lig - 6).Delete
            Application.DisplayAlerts = 1
        End With
    Next Lig
End Sub

A+ à tous
 

Océane

XLDnaute Impliqué
Bonjour JCL
Bonjour STAPLE
Je ne suis pas très doué pour utiliser les macro, encore moins pour les réaliser, c'est pour cela que je m'adresse à vous.
Ou faut-il rentre le code pour exécuter les macro....?
Est ce que l'un de vous peut les rentrer là ou il faut, je les affecterai à leur zone de texte, de la page "Tableau de bord" çà je sais faire.
Merci d'avance
 

Pièces jointes

  • FicheAtelier2 .xlsx
    27.9 KB · Affichages: 41

Océane

XLDnaute Impliqué
Bonsoir
J'ai fini par réussir à intégrer les macro, par contre j'ai un souci avec la tienne JCL, elle bug.
Par contre celle de Staple fonctionne, mais j'ai un Pb d'exploitation: Dans le sens "tableau de bord" vers feuilles F, Nom, Prénom, Date ou année de naissance, F... sont bien copier, mais dans le sens Feuilles F vers "tableau de bord" les information de total ne sont pas recopier.
Merci d'avance
 

Pièces jointes

  • FicheAtelier2 - Copie.xlsx
    173.1 KB · Affichages: 44

Staple1600

XLDnaute Barbatruc
Re à tous

Le nom de la macro que j'ai déposé MACRO1 implicitement indique donc que celle-ci ne fait que les tâches décrites dévolues à la MACRo1 détaillées par Océane dans son premier message.
Ensuite comme ici le dimanche fut ensoleillé et puisque JCGL avait pris le relais, je me laissé embarqué loin d'Excel dans une barbecue party, suivi o malheur d'une chasse au Pokémon...

De retour derrière le clavier, j'ai juste le temps de confirmer ce que vient dire JCGL, un fichier *.xlsx enregistré ne peut contenir de macros.
Je viens d'apprendre qu'ils remettent ça avec le BBQ, donc à peine revenu je dois m'éclipser.

PS:ma macro boguait également au départ, d’où le rajout de On error Resume Next
Donc essaie la macro de JCGL en rajoutant un On error Resume Next comme ceci
On error Resume Next 'à ajouter ici
For Lig = 7 To DerL
Feuil2.Copy After:=Sheets(Sheets.Count)

Bon appétit à tous
 

Océane

XLDnaute Impliqué
Bonsoir à tous les deux
Effectivement vous avez raison, il y a longtemps que j'ai travaillé avec des macro, et je n'ai pas fait gaffe....
Donc voici le bon fichier...
A+
 

Pièces jointes

  • FicheAtelier2 - Copie.xlsm
    37.6 KB · Affichages: 38

Discussions similaires

Statistiques des forums

Discussions
312 890
Messages
2 093 349
Membres
105 696
dernier inscrit
FrancisR