Sub coloriage()
Dim couleur As Long, c As Range, ca As Range, p As Long
For Each c In Range("Q6:Q231").Cells
If c.Value <> "" Then
p = Application.Match(Val(c.Offset(, 1)), [legende], 0)
couleur = Range("legende").Cells(p, 1).Interior.Color
ActiveSheet.Shapes(c.Value).Fill.ForeColor.RGB = couleur
End If
Next c
End Sub