XL 2016 Creation d´un onglet recapitulatif des notes par eleve

[jcliochon77]

Bonjour a tous,
Voila j´ai un fichier Excel avec pour chaque matiere, un onglet.
Sur chaque Onglet il y a l´intitulé des competences en colonnes , et en lignes la liste des eleves
Sur chaque colonne leur note.
Je souhaiterai pouvoir creer un onglet a la fin du livre qui me permetterait de faire un recapitulatif par eleve.
L´idée c´est de créer un bouton qui me demanderait le numero ou le nom de l´eleve , puis qui génererait une fiche eleve : ca irait piocher les intitulés + les notes uniquement de cet eleve afin de pouvoir imprimer un recapitulatif par eleve.
Ci-joint le doc. Merci!!

 

[micheldu52]

Bonsoir

Voici un début de réponse à finaliser par toi même

Je te laisse regarder l'onglet recap

Cordialement
Michel

https://wetransfer.com/downloads/b48e6eb3dcdc429c731fc7380dd14df920191120215830/6817f08299a8b8655e90b1cec77221c220191120215830/f7991

 

[patricktoulon]

Bonjour
tu a tes fiches individuelles et les entêtes pour chaque élèves

Option Explicit
Sub create_individual_fich()
   Dim I&, Nom$, C As Range, Sh As Worksheet
    Application.ScreenUpdating = False
    delete_all_afterQLM
    With Sheets("langage_oral_")
        For I = 6 To Cells(Rows.Count, "A").End(xlUp).Row

            If I <> 18 Then
                Set Sh = Sheets.Add(After:=Sheets(Sheets.Count))
                Nom = .Cells(I, 1)
                Sh.Name = Mid(.Cells(I, 1), 1, 30)
                .Range("A2:i4").Copy Destination:=Sh.Cells(1)
                .Cells(I, 1).Resize(, 9).Copy Destination:=Sh.Cells(Rows.Count, 1).End(xlUp).Offset(1)

                '***********************************

                With Sheets("lecture_et_compréhension_de_l'é")
                    Set C = .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).Find(Nom, LookIn:=xlValues)
                    If Not C Is Nothing Then
                        .Range("A2:k4").Copy Destination:=Sh.Cells(Rows.Count, 1).End(xlUp).Offset(2)
                        C.Resize(, 11).Copy Destination:=Sh.Cells(Rows.Count, 1).End(xlUp).Offset(2)
                    End If
                End With
                '***********************************
                With Sheets("écriture_")
                    Set C = .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).Find(Nom, LookIn:=xlValues)
                    If Not C Is Nothing Then
                        .Range("A1:H3").Copy Destination:=Sh.Cells(Rows.Count, 1).End(xlUp).Offset(2)
                        C.Resize(, 8).Copy Destination:=Sh.Cells(Rows.Count, 1).End(xlUp).Offset(2)
                    End If
                End With
                '***********************************

                With Sheets("étude_de_la_langue_")
                    Set C = .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).Find(Nom, LookIn:=xlValues)
                    If Not C Is Nothing Then
                        .Range("A1:L3").Copy Destination:=Sh.Cells(Rows.Count, 1).End(xlUp).Offset(2)
                        C.Resize(, 12).Copy Destination:=Sh.Cells(Rows.Count, 1).End(xlUp).Offset(2)
                    End If
                End With
                '***********************************
                With Sheets("Arts_visuels")
                    Set C = .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).Find(Nom, LookIn:=xlValues)
                    If Not C Is Nothing Then
                        .Range("A1:J4").Copy Destination:=Sh.Cells(Rows.Count, 1).End(xlUp).Offset(2)
                        C.Resize(, 10).Copy Destination:=Sh.Cells(Rows.Count, 1).End(xlUp).Offset(5)
                    End If
                End With

                '***********************************
                With Sheets("Musique")
                    Set C = .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).Find(Nom, LookIn:=xlValues)
                    If Not C Is Nothing Then
                        .Range("A1:f4").Copy Destination:=Sh.Cells(Rows.Count, 1).End(xlUp).Offset(2)
                        C.Resize(, 6).Copy Destination:=Sh.Cells(Rows.Count, 1).End(xlUp).Offset(4)
                    End If
                End With

                '***********************************
                With Sheets("QLM")
                    Set C = .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).Find(Nom, LookIn:=xlValues)
                    If Not C Is Nothing Then
                        .Range("A1:J3").Copy Destination:=Sh.Cells(Rows.Count, 1).End(xlUp).Offset(2)
                        C.Resize(, 10).Copy Destination:=Sh.Cells(Rows.Count, 1).End(xlUp).Offset(2)
                    End If
                End With
             
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub


Sub delete_all_afterQLM()
    Dim I&
    Application.DisplayAlerts = False
    For I = Sheets.Count To 8 Step -1
        If I > 7 Then Sheets(I).Delete
    Next
 
End Sub

il serait possible maintenant de réduire le code a un seul with avec deux array
array de nom de sheets et array de plage d’Entêtes

 

[Skabens]

Bonjour
plus simple sans VBA
juste une feuille de calcul et une liste déroulante pour les élèves

 

[patricktoulon]

bonsoir skabens
c'est une sheets pour chaque élèves
je suis curieux du comment tu va faire ça sans VBA ?

 

[Skabens]

bonsoir skabens
c'est une sheets pour chaque élèves
je suis curieux du comment tu va faire ça sans VBA ?

D apres ce que j'avais compris, il veut consulter élève par élève.
Sinon il peut faire une fusion Doc
Mais bien sur en VBA c est plus class

 

[jcliochon77]

Merci beaucoup pour votre temps les gars !! Je vais regarder ca ce soir !!