Sub toto()
Dim i, im, j, km, k, l, lm, m, d(), x
Dim nom, donnée, feuille, f As Worksheet
' Relevé des feuilles à traiter : Cette feuille, et toutes les feuilles
' dont le nom d'onglet dont le nom commence par "Notes".
' À adapter selon les besoins.
feuille = Array(Me.Name)
For Each f In ThisWorkbook.Worksheets
If f.Name Like "Notes*" Then
ReDim Preserve feuille(1 + UBound(feuille))
feuille(UBound(feuille)) = f.Name
End If
Next
' On aurait pu aussi écrire :
' feuille = Array("Base", "Notes Spéciales", "Notes1", "Notes2", "Notes3")
km = UBound(feuille)
With ThisWorkbook.Worksheets(feuille(0))
im = .Cells(Feuil1.Rows.Count, 1).End(xlUp).Row - 1
ReDim d(1 To im, 1 To 5, 1 To km)
For i = 1 To im
nom = .[A1].Offset(i).Value
For j = 1 To 5
donnée = .[A1].Offset(, j).Value
For k = 1 To km
With ThisWorkbook.Worksheets(feuille(k))
lm = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
With .[A1]
For l = 1 To lm
If .Offset(l).Value = nom Then
For m = 1 To 5
If .Offset(, m).Value = donnée Then
With .Offset(l, m)
If Not IsEmpty(.Value) Then d(i, j, k) = d(i, j, k) + .Value
End With
End If
Next
End If
Next
End With
End With
Next k, j, i
' À ce stade, d(i,j,k) contient le cumul des valeurs associés au nom i et à la donnée j dans la feuil notes k.
' On en fait alors le traitement qu'on veut. Par exemple :
For i = 1 To im: For j = 1 To 5
x = Empty
For k = 1 To km
If Not IsEmpty(d(i, j, k)) Then x = x + d(i, j, k)
Next
.[A1].Offset(i, j).Value = x
Next j, i
With .Range("G2").Resize(im, 1)
.FormulaArray = "=IF(RC[-1]:R[" & im - 1 & "]C[-1]="""","""",IF(ISERROR(RANK(RC[-1]:R[" & im - 1 & "]C[-1],RC[-1]:R[" & im - 1 & "]C[-1],0)),"""",RANK(RC[-1]:R[" & im - 1 & "]C[-1],RC[-1]:R[" & im - 1 & "]C[-1],0)))"
.Value = .Value
End With
End With
End Sub