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