Private Sub Worksheet_Activate()
Dim d As Object, a(), tablo, i&, x$, n&, j%, lig&
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
ReDim a(1 To Rows.Count, 1 To 5)
tablo = [Tableau1].Resize(, 5) 'matrice, plus rapide
For i = 1 To UBound(tablo)
x = tablo(i, 1) & Chr(1) & tablo(i, 2) & Chr(1) & tablo(i, 3)
If Not d.exists(x) Then
n = n + 1
d(x) = n 'mémorise la ligne
For j = 1 To 5
a(n, j) = tablo(i, j)
Next j
End If
lig = d(x) 'récupère la ligne
If tablo(i, 4) < a(lig, 4) Then a(lig, 4) = tablo(i, 4)
If tablo(i, 5) > a(lig, 5) Then a(lig, 5) = tablo(i, 5)
Next i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de destination, à adapter
If n Then
.Resize(n, 5) = a
.Resize(n, 5).Borders.Weight = xlThin 'bordures
End If
.Offset(n).Resize(Rows.Count - n - .Row + 1, 5).Delete xlUp 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub