Private Sub Worksheet_Activate()
Dim t, resu$(), i&, n&
Application.ScreenUpdating = False
Range("A2:B" & Rows.Count).Delete xlUp 'RAZ
With Feuil1 'CodeName de la feuille "Base"
.[C2] = "=(A2=G$3)*(Initiales(B2)=H$3)+(A2=G$4)*(Initiales(B2)=H$4)+(Initiales(B2)=H$6)+(Initiales(B2)=H$7)" 'critère
.[A1].CurrentRegion.Resize(, 2).AdvancedFilter xlFilterCopy, .[C1:C2], [A3]
.[C2] = ""
End With
[A3].CurrentRegion.Sort [A3], xlAscending, Header:=xlYes 'tri
Columns.AutoFit 'ajustement largeur
'---insertion de lignes---
t = [A3].CurrentRegion.Resize(, 2) 'matrice, plus rapide
ReDim resu(1 To 2 * UBound(t), 1 To 2)
resu(1, 1) = t(1, 1): resu(1, 2) = t(1, 2): n = 1
For i = 2 To UBound(t)
n = n + 1 - (t(i - 1, 1) <> t(i, 1))
resu(n, 1) = t(i, 1): resu(n, 2) = t(i, 2)
Next
[A3].Resize(n, 2) = resu
With Me.UsedRange: End With 'actualise la barre de défilement verticale
End Sub