Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
Dim Coll As Collection
Dim i&
Application.ScreenUpdating = False
If Target.Count > 1 Then Exit Sub
Set Coll = New Collection
If Not Intersect(Target, [Liste]) Is Nothing Then
For Each Cell In [Liste]
On Error Resume Next
Coll.Add Cell, CStr(Cell)
Next Cell
[G2:G1000].ClearContents
For i = 1 To Coll.Count
Range("G" & i + 1).Value = Coll.Item(i)
Next i
Range("G2:G" & [G65000].End(xlUp).Row).Sort Key1:=[G2], Order1:=xlAscending
Range("G2:G" & [G65000].End(xlUp).Row).Name = "ListeMatieres"
End If
End Sub