bonjour,
code adapté
Sub aargh()
For Each ws In Worksheets
If ws.Name <> "accueil" And InStr(ws.Name, "equipe") <> 0 Then
i = 5
s = ""
maxv = -1
While ws.Cells(i, 4) <> ""
v = Val(Right(ws.Cells(i, 4), 3))
If v > maxv Then maxv = v: s = ws.Cells(i, 4)
i = i + 1
Wend
Sheets(Replace(ws.Name, " equipe", "")).Cells(1, 4) = s
End If
Next ws
End Sub