Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&, vStr, s_trings
vStr = Array("coul", "bur", "lt")
s_trings = Array("couleurs", "bureaux", "locaux")
If Target.Column = 1 Then
For i = 0 To 2
Select Case InStr(Target, vStr(i))
Case Is > 1
Target(1, 3) = s_trings(i)
Case Else
'
End Select
Next
End If
End Sub