Массовый ВПР картинок в ехcel (VLOOKUP for pictures/ВПР для изображений/Как подтянуть фото в excel)

Подробно, как работает макрос, описано в видео

Sub coda()

'

' coda Макрос

'

'

Sheets("Таблица").Select

Columns("A:A").Select

Selection.Delete Shift:=xlToLeft

Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("A1").Select

ActiveCell.FormulaR1C1 = "Фото"

Range("A2").Select

Dim k As Integer

k = Cells(Rows.Count, "B").End(xlUp).Row

Dim q As Integer

q = 2

Do While q <= k

Dim myPhrase As Variant, myCell As Range

myPhrase = Sheets("Таблица").Cells(q, 2)

Set myCell = Sheets("Список").Range("A:A").Find(myPhrase)

On Error Resume Next

If Not myCell Is Nothing Then

Sheets("Список").Select

Cells(myCell.Row, 2).Copy Sheets("Таблица").Cells(q, 1)

End If

q = q + 1

Loop

Sheets("Таблица").Select

Columns("A:A").Select

Selection.ColumnWidth = 24.29

Rows("4:" & k - 1).Select

Range(Selection, Selection.End(xlDown) - 1).Select

Selection.RowHeight = 111

With Selection

.VerticalAlignment = xlCenter

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Range("B2").Select

Selection.Copy

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Range(Columns(4), Columns(Cells(3, Columns.Count).End(xlToLeft).Column)).EntireColumn.Select

Selection.ColumnWidth = 17

Range("A1:A3").Select

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

End Sub