Sub km()
Dim Tablo, i%, j%, KmMax, Entreprise$
Tablo = [A1].CurrentRegion
For i = 2 To UBound(Tablo)
Entreprise = Split(Tablo(i, 1), " ")(0)
KmMax = 0
For j = 2 To UBound(Tablo)
If Tablo(j, 1) Like Entreprise & "*" Then
KmMax = Application.Max(KmMax, Tablo(j, 2))
End If
Next j
Tablo(i, 3) = KmMax
Next i
[A1].Resize(UBound(Tablo, 1), UBound(Tablo, 2)) = Tablo
End Sub