Sub Images()
Dim F As Worksheet, d As Object, c As Range, s As Shape, sc&
Set F = Feuil2 'CodeName, à adapter
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
For Each c In F.UsedRange.SpecialCells(xlCellTypeConstants)
If c.Column = 14 Then d(c.Value) = "AutoShape 13"
If c.Column = 15 Then d(c.Value) = "Oval 93"
Next c
With ActiveSheet
For Each s In .Shapes
If s.Name Like "AutoShape*" Or s.Name Like "Oval*" Then s.Delete
Next s
For Each c In .UsedRange.SpecialCells(xlCellTypeConstants)
If d.exists(c.Value) Then
F.Shapes(d(c.Value)).Copy
sc = .Shapes.Count
Do
.Paste
DoEvents
Loop While .Shapes.Count = sc 'attente de l'exécution
Selection.Top = c.Top + 2
Selection.Left = c(1, 2).Left - Selection.Width - 2 'cadrage à droite
End If
Next c
ActiveCell.Activate 'désélectionne l'objet
End With
End Sub