Sub test()
Dim t, a, ub As Byte, remp$, tablo, i&, x$, j As Byte
t = Timer
a = Array("ABON TURBO ON LINE ENT", "COTIS CYBERPLUS", "FRAIS VIR EUROP. PAPIER")
ub = UBound(a)
remp = "ABONN TELETRANSMISSION"
tablo = Intersect(ActiveSheet.UsedRange.EntireRow, Columns("H")) 'matrice, plus rapide
For i = 1 To UBound(tablo)
x = tablo(i, 1)
For j = 0 To ub
If InStr(x, a(j)) Then tablo(i, 1) = remp: Exit For
Next
Next
Intersect(ActiveSheet.UsedRange.EntireRow, Columns("H")) = tablo
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub