Невозможно выбрать фигуру по имени, используя значение ячейки

Копировать фигуры из списка (словарь)

Кодекс

Option Explicit

Sub copyShapes()
    
    With CreateObject("Scripting.Dictionary")
        ' Allow case-insensitivity e.g. 'Picture = PICturE'.
        .CompareMode = vbTextCompare
        ' Define workbook.
        Dim wb As Workbook
        Set wb = ThisWorkbook ' The workbook containing this code.
        ' Define Source Worksheet.
        Dim src As Worksheet
        Set src = wb.Worksheets("Images")
        ' Write the names of its shapes to the Dictionary.
        Dim shp As Shape
        For Each shp In src.Shapes
            .Item(shp.Name) = Empty
        Next shp
        ' Check if any shapes were found.
        If .Count > 0 Then
            ' Define Destination Worksheet.
            Dim dst As Worksheet
            Set dst = wb.Worksheets("Pilot products")
            ' Declare variables.
            Dim i As Long
            Dim ShapeIndex As String
            Dim ShapeName As String
            ' Loop through cells containing the shape indexes and copy
            ' the found shapes in the Dictionary from Source Worksheet
            ' to Destination Worksheet.
            For i = 2 To 224
                ShapeIndex = CStr(dst.Cells(i, 9).Value)
                If ShapeIndex <> "" And ShapeIndex <> "0" Then
                    ShapeName = "Picture " & ShapeIndex
                    If .Exists(ShapeName) Then
                        src.Shapes(ShapeName).Copy
                        dst.Paste Destination:=dst.Cells(i, 10)
                    Else
                      ' A shape (picture) with this number doesn't exist.
                    End If
                Else
                  ' NumStr is either "" or "0".
                End If
            Next i
        Else
          ' Dictionary is empty i.e. no shapes found.
        End If
    End With

End Sub

Если вы не слишком хорошо знакомы с объектом Dictionary, вам следует использовать его следующим образом: (Обратите внимание на '***, обозначающий изменения.)

Sub copyShapes2()
    
    Dim dict As Object '***
    Set dict = CreateObject("Scripting.Dictionary") '***
    ' Allow case-insensitivity e.g. 'Picture = PICturE'.
    dict.CompareMode = vbTextCompare '***
    ' Define workbook.
    Dim wb As Workbook
    Set wb = ThisWorkbook ' The workbook containing this code.
    ' Define Source Worksheet.
    Dim src As Worksheet
    Set src = wb.Worksheets("Images")
    ' Write its shape names to the Dictionary.
    Dim shp As Shape
    For Each shp In src.Shapes
        dict(shp.Name) = Empty '***
    Next shp
    
    If dict.Count > 0 Then '***
        ' Define Destination Worksheet.
        Dim dst As Worksheet
        Set dst = wb.Worksheets("Pilot products")
        ' Declare variables.
        Dim i As Long
        Dim NumStr As String
        Dim ShapeName As String
        ' Loop through cells containing the shape indexes and copy
        ' the found shapes in the Dictionary from Source Worksheet
        ' to Destination Worksheet.
        For i = 2 To 224
            NumStr = CStr(dst.Cells(i, 9).Value)
            If NumStr <> "" And NumStr <> "0" Then
                ShapeName = "Picture " & NumStr
                If dict.Exists(ShapeName) Then '***
                    src.Shapes(ShapeName).Copy
                    dst.Paste Destination:=dst.Cells(i, 10)
                Else
                  ' A shape (picture) with this number doesn't exist.
                End If
            Else
              ' NumStr is either "" or "0".
            End If
        Next i
    Else
      ' Dictionary is empty i.e. no shapes found.
    End If

End Sub