Подробно, как работает макрос, описано в видео
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