Création de fiches pré remplis a partir d'une liste

Version imprimable

Bonsoir,
Novice dans la manipulation de macro en VBA sous excel (ou autre d'ailleurs), je fais appel à vos bons conseils.
Je souhaite créer un fichier excel permettant de créer des feuilles de compétences pré remplis (feuille au nom de l'élève et grille de compétence vide) à partir d'un liste d’élève et d'une feuille regroupant toutes les compétence demandées).
Grace à ce forum j'ai déjà réussi a créer les feuilles aux noms des élève en affectant une macro (trouvé ici) à un bouton mais pour la copie de ma grille dans ces nouvelles feuilles je bloque.
Merci de votre aide.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 Sub t() Dim rng As Range, cel As Range Set rng = ThisWorkbook.Worksheets("liste").Range("A2:A3") For Each cel In rng If Not (WorkSheetCreate(cel.Value)) Then MsgBox "La feuille " & cel.Value & " existe déjà" Next End Sub Function WorkSheetCreate(Name As String) As Boolean Application.ScreenUpdating = False Worksheets.Add before:=Worksheets(1) On Error Resume Next Worksheets(1).Name = Name If Err Then With Application .DisplayAlerts = False: Worksheets(1).Delete: .DisplayAlerts = True WorkSheetCreate = False End With Else WorkSheetCreate = True End If On Error GoTo 0 Application.ScreenUpdating = False End Function

Essaies comme ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Option Explicit
 
Sub T()
Dim Rng As Range, Cel As Range
 
With ThisWorkbook
    Set Rng = .Worksheets("Liste").Range("A2:A3")
    For Each Cel In Rng
        If Cel.Value <> "" Then
            If Not FeuilleExiste(Cel.Value) Then
                .Worksheets("NomFeuilleGrille").Copy Before:=.Worksheets(1)
                ActiveSheet.Name = Cel.Value
            End If
        End If
    Next Cel
End With
End Sub
 
'Fonction qui permet de tester l'existence d'une feuille nommée Nom
Private Function FeuilleExiste(ByVal Nom As String) As Boolean
 
On Error Resume Next
FeuilleExiste = ThisWorkbook.Sheets(Nom).Index
End Function

Sinon, on parlera ensuite des contraintes éventuelles ultérieures.

Merci de cette rapidité.
C'est tout à fait ce que je recherchais.
Pour les contraintes, je me suis rendu compte (après quelques recherches) que l'on pouvait uniquement faire une copie conforme de la page d'origine.
J'ai donc modifier le "patron " de ma grille de compétence afin de pouvoir rajouter des informations présente sur ma liste (nom élève et classe).

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Option Explicit
 
Sub T()
Dim Rng As Range, Cel As Range, Nom As String
 
With ThisWorkbook
    Set Rng = .Worksheets("Liste").Range("A2:A3")
    For Each Cel In Rng
        If Cel.Value <> "" Then
            If Not FeuilleExiste(Cel.Value) Then
                .Worksheets("competence").Copy after:=.Worksheets(1)
' infos à mettre dans ma nouvelle feuille
                Nom = Cel.Value
                  ActiveSheet.Name = Cel.Value
                 .Worksheets(Nom).Range("A1") = Nom
                 .Worksheets(Nom).Range("C1") = .Worksheets("Liste").Range("A1")
 
            End If
        End If
    Next Cel
End With
End Sub
 
'Fonction qui permet de tester l'existence d'une feuille nommée Nom
Private Function FeuilleExiste(ByVal Nom As String) As Boolean
 
On Error Resume Next
FeuilleExiste = ThisWorkbook.Sheets(Nom).Index
End Function