Sub AffecteFlèche()
Application.ScreenUpdating = False
For Each c In Cells.SpecialCells(xlCellTypeAllValidation)
ActiveSheet.Shapes("fleche1").Copy
c.Offset(, 1).Select
DoEvents
ActiveSheet.Paste
DoEvents
With Selection
.Name = c.Address
.Left = c.Offset(, 1).Left
.Top = c.Offset(, 1).Top + 1
.Height = c.Offset(, 1).Height
.OnAction = "clicFlèche"
End With
Next c
End Sub