Sub Remplissage()
Dim t, d1 As Object, d2 As Object, i&, x$, y$
t = Sheets("Data").[A1].CurrentRegion.Resize(, 9)
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
x = t(i, 5): y = t(i, 6)
If x <> "" And x <> "Vide" Then
If d1.exists(y) Then
d1(y) = d1(y) & "-" & x
Else
d1(y) = x
End If
d2(t(i, 8)) = x
End If
Next
With Sheets("Change").[A1].CurrentRegion.Resize(, 9)
t = .Value
For i = 2 To UBound(t)
t(i, 1) = d1(t(i, 2)): t(i, 9) = d2(t(i, 5))
Next
If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
.Columns(1) = Application.Index(t, , 1)
.Columns(9) = Application.Index(t, , 9)
End With
End Sub