Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
For Each r In r 'si entrées multiples
If LCase(r) = "am" Then
Feuil2.Shapes(1).Copy 'CodeName de la feuille source
Me.Paste
With Selection
.Left = r.Left
.Top = r.Top
.Name = r.Address
End With
End If
Next
ActiveCell.Activate
End Sub
Sub Effacer()
On Error Resume Next
Range(Application.Caller) = ""
Shapes(Application.Caller).Delete
End Sub