Private Sub Worksheet_Change(ByVal R As Range)
Dim x As Range
If R.Address = "$B$8" And R.Count = 1 Then
Set x = R.Offset(1)
On Error Resume Next
ActiveSheet.Shapes("Signature").Delete
On Error GoTo 0
If R <> "" Then
Sheets("données").Shapes(R.Text).Copy
x.Select
ActiveSheet.Paste
With Selection
.Name = "Signature"
.ShapeRange.Left = x.Left: .ShapeRange.Top = x.Top
End With
R.Select
End If
End If
End Sub