Option Explicit
Option Compare Text
Sub Moyenne_des_notes()
Dim ws As Worksheet, a, i As Long, j As Long
Dim txt As String, b(), n As Long, t As Long
ReDim b(1 To 1000, 1 To 2): n = 1
b(1, 1) = "Prénom": b(1, 2) = "Nom"
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For Each ws In Worksheets
If ws.Name Like "Cours*" Then
t = t + 1
ReDim Preserve b(1 To UBound(b, 1), 1 To 2 + t)
b(1, UBound(b, 2)) = ws.Name
a = ws.Range("a5").CurrentRegion.Value
For i = 2 To UBound(a, 1)
txt = Join$(Array(a(i, 1), a(i, 2)), Chr(2))
If Not .exists(txt) Then
n = n + 1: .Item(txt) = n
For j = 1 To 2
b(n, j) = a(i, j)
Next
End If
b(.Item(txt), UBound(b, 2)) = a(i, UBound(a, 2)): txt = ""
Next
End If
Next
End With
With Sheets("Feuil1").Cells(1).Resize(n, UBound(b, 2))
.CurrentRegion.Clear
.Value = b
With .CurrentRegion
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
With .Rows(1)
.Interior.ColorIndex = 19
.BorderAround Weight:=xlThin
End With
With .Offset(1, 2).Resize(.Rows.Count - 1, .Columns.Count - 2)
.NumberFormat = "#,##0.00"
End With
.Columns.AutoFit
End With
.Parent.Select
End With
End Sub