XL 2016 macro exectutable si valeur cellule

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'If D2 Then

If Target.Address <> "$D$2" Then Exit Sub
    If Not IsNumeric(Sh.Name) Then Exit Sub
    Dim c As Range, S As Shape
    Application.ScreenUpdating = False
    On Error Resume Next

        For Each c In Sh.[K:K].SpecialCells(xlCellTypeFormulas)
            Set S = Nothing
            Set S = Sheets("Base").Shapes(c)
            If Not S Is Nothing Then
                c(1, 0).Select
                S.CopyPicture
                Sh.Paste
                Selection.ShapeRange.LockAspectRatio = msoFalse
                Selection.Width = c(1, 0).Width
                Selection.Height = c(1, 0).Height
            End If
        Next

    Application.GoTo Sh.[A1], True 'cadrage
    ActiveCell.Copy ActiveCell 'vide le presse-papiers
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Address <> "$D$2" Then Exit Sub
  If Not IsNumeric(Sh.Name) Then Exit Sub
  Dim c As Range, S As Shape
  Application.ScreenUpdating = False
  On Error Resume Next

  For Each c In Sh.[K:K].SpecialCells(xlCellTypeFormulas)
    Set S = Nothing
    Set S = Sheets("Base").Shapes(c)
    If Not S Is Nothing Then
      c(1, 0).Select
      S.CopyPicture
      Sh.Paste
      Selection.ShapeRange.LockAspectRatio = msoFalse
      Selection.Width = c(1, 0).Width
      Selection.Height = c(1, 0).Height
    End If
  Next c

  Application.GoTo Sh.[A1], True 'cadrage
  ActiveCell.Copy ActiveCell 'vide le presse-papiers
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c As Range
If Not Application.Intersect(Target, Range("D2")) Is Nothing Then
Application.ScreenUpdating = False
On Error Resume Next
For Each c In Me.[K:K].SpecialCells(-4123)
c(1, 0).Select: CopierShape Sheets("Base"), Me, c.Value
With Selection: .ShapeRange.LockAspectRatio = 0: .Width = c(1, 0).Width: .Height = c(1, 0).Height: End With
Next
Application.GoTo [A1], True 'cadrage
ActiveCell.Copy ActiveCell 'vide le presse-papiers
End If
End Sub
Private Sub CopierShape(ws1 As Worksheet, ws2 As Worksheet, shpIdx&)
Dim shp As Shape
Set shp = ws1.Shapes(shpIdx).Duplicate: shp.Cut: ws2.Paste
End Sub