Option Explicit
Sub Test()
Application.ScreenUpdating = False
Dim WsS As Worksheet, WsC As Worksheet, TDévia(), Ld&, TWorkon(), Lw&, TRésu()
' Dim Te(1 To 500) As String, Le As Long ' Variables globales module. Inutilisés ici
Set WsS = Worksheets("Workon")
Set WsC = Worksheets("Data-Deviations")
TDévia = WsC.Range("AG2:AG" & WsC.Range("AG" & Rows.Count).End(xlUp).Row).Value
ReDim TRésu(1 To UBound(TDévia), 1 To 1)
TWorkon = WsS.Range("S2:T" & WsS.Range("S" & Rows.Count).End(xlUp).Row).Value
For Ld = 1 To UBound(TDévia)
For Lw = 1 To UBound(TWorkon)
If InStr(TDévia(Ld, 1), TWorkon(Lw, 1)) > 0 Then Ajouter TWorkon(Lw, 2)
Next Lw
TRésu(Ld, 1) = RésultatCellClassé: Next Ld
WsC.[AI2].Resize(UBound(TRésu)).Value = TRésu
' Application.ScreenUpdating = True ' N'apporte rien : Assumé après exécution
' Application.Calculation = xlAutomatic ' Il n'a pas été mis XlManual que je sache.
End Sub