Sub ExtraireListeElèves()
Dim C2 As Range 'Etablissement
Dim E2 As Range 'Professeur
Dim C4 As Range 'Début liste d'élèves
Dim LigneT As Range, Ecole As Range, Tableau, Tb_Élèves()
Dim k As Integer, i As Integer, NbLgns, NbCols
Set C2 = F02_Eval.[C2]: Set E2 = F02_Eval.[E2]: Set C4 = F02_Eval.[C4]
'Nettoyage de la zone cible
F02_Eval.[_Liste].ClearContents
NbLgns = F02_Eval.[_Liste].Rows.Count
If NbLgns > 1 Then F02_Eval.[C4].Offset(1).Resize(F02_Eval.[_Liste].Rows.Count - 1).EntireRow.Delete
If C2 = "" Or E2 = "" Then Exit Sub
'Ligne de titre de la BdD
With F01_BdD.Rows(2): Set LigneT = .Resize(1, .Columns(.Columns.Count).End(xlToLeft).Column): End With
With LigneT: NbCols = .Cells.Count + .Cells(.Cells.Count).MergeArea.Columns.Count - 1: End With
Set LigneT = LigneT.Resize(1, NbCols)
'Plage concernant l'école
Set Ecole = Nothing
Set Ecole = LigneT.Find(What:=Replace(C2, "_", " "), after:=LigneT.Cells(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
If Ecole Is Nothing Then Exit Sub
'nombre de colonnes et de lignes de la zone de l'établissement
NbCols = Ecole.MergeArea.Columns.Count
With Ecole.EntireColumn: NbLgns = .Cells(.Rows.Count).End(xlUp).Row - Ecole.Row + 1: End With
'Récupération des données de la zone établissement dans un tableau
Tableau = Ecole.Resize(NbLgns, NbCols)
k = 0
i = 1
'recherche de la ligne "ELEVES"
Do While Tableau(i, 1) <> "ELEVES"
i = i + 1
If i = NbLgns Then Exit Do
Loop
If Tableau(i, 1) <> "ELEVES" Or i = NbLgns Then Exit Sub
'recherche de la ligne du professeur
Do While Tableau(i, 1) <> E2
i = i + 1
If i = NbLgns Then Exit Do
Loop
If Tableau(i, 1) <> E2 Or i = NbLgns Then Exit Sub
'enregistrement de la liste des élèves
i = i + 1
Do While Tableau(i, 2) <> ""
k = k + 1: ReDim Preserve Tb_Élèves(1 To k): Tb_Élèves(k) = Tableau(i, 1): i = i + 1
If i > NbLgns Then Exit Do
Loop
If k = 0 Then Exit Sub
'ajout des lignes nécessaires
C4.Offset(1).Resize(k - 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'Copie de la liste des élèves
C4.Resize(k).Value = WorksheetFunction.Transpose(Tb_Élèves)
End Sub