Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [J2]) Is Nothing Then Exit Sub
Dim d As Object, ncol%, an, tablo, resu(), s$, i&, x$, n&, nn&, j%
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
ncol = 8 'nombre de colonnes
an = [J2]
tablo = Feuil1.[A1].CurrentRegion.Resize(, ncol).Value2 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To ncol - 1) 'la colonne A n'est pas restituée
resu(1, ncol - 1) = tablo(1, ncol)
s = Chr(1) 'séparateur
For i = 1 To UBound(tablo)
If i = 1 Or Year(Val(tablo(i, 1))) = an Or an = "" Then
x = tablo(i, 2) & s & tablo(i, 3) & s & tablo(i, 4) & s & tablo(i, 5) & s & tablo(i, 6) & s & tablo(i, 7)
If Not d.exists(x) Then
n = n + 1
d(x) = n 'mémorise la ligne
End If
nn = d(x)
If IsNumeric(tablo(i, ncol)) Then resu(nn, ncol - 1) = resu(nn, ncol - 1) + CDbl(tablo(i, ncol))
For j = 2 To ncol - 1
resu(nn, j - 1) = tablo(i, j)
Next j
End If
Next i
'---restitution en 2ème feuille---
With Feuil2 'CodeName
.UsedRange.ClearContents 'RAZ
.[A1].Resize(n, ncol - 1) = resu
If n > 1 Then .[A2].Resize(n - 1, ncol - 1).Name = "Source" 'plage nommée
End With
'---ouverture de l'UserForm---
With UserForm1
.Caption = IIf(an = "", "Toutes années", "Année " & an)
.ListBox1.RowSource = IIf(n > 1, "Source", "")
.Show
End With
End Sub