Copier une shape sur 12 onglets

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$B$12" And Target.Count = 1 Then
    On Error Resume Next
    ActiveSheet.Shapes("monimage").Delete
    On Error GoTo 0
    If Target <> "" Then
        For i = 1 To 13
          With Sheets(i)
            .Activate
            Supp_image
        Sheets("Images").Shapes(Target).Copy
        .[B4].Select
        ActiveSheet.Paste
        .[B4].Select
        End With
        Next
     End If
  End If
  Sheets("Accueil").Activate
  Target.Select
End Sub
Sub Supp_image()
Dim Imag As Object
 For Each Imag In ActiveSheet.DrawingObjects
     If TypeOf Imag Is Picture Then
         Imag.Delete
     End If
 Next Imag
End Sub