Discussion :

[Tekken24]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[mercatog]

Essaies comme ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[Tekken24]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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