Может логичнее наоборот, брать код из таблицы и проверять, существует ли картинка?
Sub Макрос1()
Dim code, pic As Integer
Dim i As Integer
Dim path As String
' номер столбца с кодами товаров
code = 3
' номер столбца для картинок
pic = 4
' путь к папке с картинками
path = "C:\Users\admin\Pictures\"
i = 1
While (Cells(i, code) <> "")
' возможно нужно будет дописывать еще и расширение картинки
If Len(Dir$(path & Str(Cells(i, code)))) > 0 Then
InsertPicture Cells(i, pic), (path & Cells(i, code)), True, True, True
End If
i = i + 1
Wend
End Sub
Sub InsertPicture(ByRef PicRange As Range, ByVal PicPath As String, _
Optional ByVal AdjustWidth As Boolean, _
Optional ByVal AdjustHeight As Boolean, _
Optional ByVal AdjustPicture As Boolean = False)
On Error Resume Next: Application.ScreenUpdating = False
Dim ph As Picture: Set ph = PicRange.Parent.Pictures.Insert(PicPath)
ph.Top = PicRange.Top: ph.Left = PicRange.Left
K_picture = ph.Width / ph.Height
K_PicRange = PicRange.Width / PicRange.Height
If AdjustPicture Then
If AdjustWidth Then ph.Width = PicRange.Width: ph.Height = ph.Width / K_picture
If AdjustHeight Then ph.Height = PicRange.Height: ph.Width = ph.Height * K_picture
If AdjustWidth And AdjustHeight Then ph.Width = PicRange.Width: ph.Height = PicRange.Height
Else
If AdjustWidth Then
PicRange.Cells(1).ColumnWidth = PicRange.Cells(1).ColumnWidth * ph.Width / PicRange.Cells(1).Width
While Abs(PicRange.Cells(1).Width - ph.Width) > 0.1
PicRange.Cells(1).ColumnWidth = PicRange.Cells(1).ColumnWidth - 0.2 * (PicRange.Cells(1).Width - ph.Width)
Wend
End If
If AdjustHeight Then
PicRange.Cells(1).RowHeight = PicRange.Cells(1).RowHeight * ph.Height / PicRange.Cells(1).Height
While Abs(PicRange.Cells(1).Height - ph.Height) > 0.1
PicRange.Cells(1).RowHeight = PicRange.Cells(1).RowHeight - 0.2 * (PicRange.Cells(1).Height - ph.Height)
Wend
End If
End If
End Sub
Функция вставки взята
отсюда.