Re,
Il suffit d'ajouter la fonction à ta sub Test()
Sub Test()
Application.ScreenUpdating = False
Dim WsS As Worksheet, WsC As Worksheet
Dim Cel As Range, c As Range
Dim Position As Integer, MemoPos As Integer
Set WsS = Worksheets("Workon")
Set WsC = Worksheets("Data-Deviations")
Sheets("Data-Deviations").Activate
Range("AI2:AI1000000").ClearContents
For Each Cel In WsC.Range("AG2:AG" & WsC.Range("AG" & Rows.Count).End(xlUp).Row)
MemoPos = 1000
For Each c In WsS.Range("S2:S" & WsS.Range("S" & Rows.Count).End(xlUp).Row)
Position = InStr(Cel, c)
If Position > 0 Then
If Cel.Offset(0, 2) <> "" And InStr(Cel.Offset(0, 2), c.Offset(0, 1)) = 0 Then
' ligne And InStr(Cel.Offset(0, 2), C.Offset(0, 1)) = 0 supprime doublon
If Position < MemoPos Then
MemoPos = Position
Cel.Offset(0, 2) = c.Offset(0, 1) & Chr(10) & Cel.Offset(0, 2)
Else
Cel.Offset(0, 2) = Cel.Offset(0, 2) & Chr(10) & c.Offset(0, 1)
End If
Else
Cel.Offset(0, 2) = c.Offset(0, 1)
MemoPos = Position
End If
End If
Next c
' Appliquer le tri à la cellule
Cel.Offset(0, 2).Value = TriCell(Cel.Offset(0, 2).Value)
Next Cel
Set WsC = Nothing: Set WsS = Nothing
Application.ScreenUpdating = True
End Sub
A+