Советы по ускорению кода, который копирует / вставляет изображения?

Это мой первый проект с использованием VBA. У меня есть код (см. Ниже), который читает, если число на листе присутствует. Если это так, то код вызовет макрос для копирования исходного изображения с другого листа, вставки его на новый лист и переименования / изменения размера / центрирования вставленного изображения в ячейке.

Проблема в том, что я уже могу сказать, что этот код работает медленно. Я знаю, что использование «.select» сильно замедляет работу кода, но я не знаю, есть ли обходной путь для того, что мне нужно сделать.

Вот рабочий (хотя и медленный) код, который у меня есть. (прокрутите вниз для справочной картинки)

Это первый код, который проверяет числа и вызывает макросы:

Sub xGridA_Pic_Setup() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual  If Evaluate(WorksheetFunction.CountIf(Worksheets("Rent Grid A").Range("D1:H1"), "1")) < 1 Then Else Call xGridA_Comp1 End If If Evaluate(WorksheetFunction.CountIf(Worksheets("Rent Grid A").Range("D1:H1"), "2")) < 1 Then Else Call xGridA_Comp2 End If If Evaluate(WorksheetFunction.CountIf(Worksheets("Rent Grid A").Range("D1:H1"), "3")) < 1 Then Else Call xGridA_Comp3 End If If Evaluate(WorksheetFunction.CountIf(Worksheets("Rent Grid A").Range("D1:H1"), "4")) < 1 Then Else Call xGridA_Comp4 End If If Evaluate(WorksheetFunction.CountIf(Worksheets("Rent Grid A").Range("D1:H1"), "5")) < 1 Then Else Call xGridA_Comp5 End If  If Worksheets("Rent Roll").Range("TOTAL_UNIT_TYPE") > 1 Then End If  Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub  

Вот фрагмент макроса, который он вызывает:

Sub xGridA_Comp1()  Sheets("Rent Data Entry").Select ActiveSheet.Shapes.Range(Array("PIC_RENTCOMP1")).Select Selection.Copy  Sheets("Rent Grid A").Select If Range("D1") <> 1 Then Else Range("RGA_COMP1_CELL").Select ActiveSheet.Paste With ActiveSheet.Shapes.Range(Array("PIC_RENTCOMP1")).Select Selection.Name = "PIC_RGA_CMP1_1" Selection.ShapeRange.Height = 97.2 Selection.ShapeRange.Width = 129.6 End With With ActiveSheet.Shapes("PIC_RGA_CMP1_1") .Top = Range("RGA_COMP1_CELL").Top + (Range("RGA_COMP1_CELL").Height - .Height) / 2 .Left = Range("RGA_COMP1_CELL").Left + (Range("RGA_COMP1_CELL").Width - .Width) / 2 End With End If   If Range("E1") <> 1 Then Else Range("RGA_COMP2_CELL").Select ActiveSheet.Paste With ActiveSheet.Shapes.Range(Array("PIC_RENTCOMP1")).Select Selection.Name = "PIC_RGA_CMP1_2" Selection.ShapeRange.Height = 97.2 Selection.ShapeRange.Width = 129.6 End With With ActiveSheet.Shapes("PIC_RGA_CMP1_2") .Top = Range("RGA_COMP2_CELL").Top + (Range("RGA_COMP2_CELL").Height - .Height) / 2 .Left = Range("RGA_COMP2_CELL").Left + (Range("RGA_COMP2_CELL").Width - .Width) / 2 End With End If   If Range("F1") <> 1 Then Else Range("RGA_COMP3_CELL").Select ActiveSheet.Paste With ActiveSheet.Shapes.Range(Array("PIC_RENTCOMP1")).Select Selection.Name = "PIC_RGA_CMP1_3" Selection.ShapeRange.Height = 97.2 Selection.ShapeRange.Width = 129.6 End With With ActiveSheet.Shapes("PIC_RGA_CMP1_3") .Top = Range("RGA_COMP3_CELL").Top + (Range("RGA_COMP3_CELL").Height - .Height) / 2 .Left = Range("RGA_COMP3_CELL").Left + (Range("RGA_COMP3_CELL").Width - .Width) / 2 End With End If   If Range("G1") <> 1 Then Else Range("RGA_COMP4_CELL").Select ActiveSheet.Paste With ActiveSheet.Shapes.Range(Array("PIC_RENTCOMP1")).Select Selection.Name = "PIC_RGA_CMP1_4" Selection.ShapeRange.Height = 97.2 Selection.ShapeRange.Width = 129.6 End With With ActiveSheet.Shapes("PIC_RGA_CMP1_4") .Top = Range("RGA_COMP4_CELL").Top + (Range("RGA_COMP4_CELL").Height - .Height) / 2 .Left = Range("RGA_COMP4_CELL").Left + (Range("RGA_COMP4_CELL").Width - .Width) / 2 End With End If   If Range("H1") <> 1 Then Else Range("RGA_COMP5_CELL").Select ActiveSheet.Paste With ActiveSheet.Shapes.Range(Array("PIC_RENTCOMP1")).Select Selection.Name = "PIC_RGA_CMP1_5" Selection.ShapeRange.Height = 97.2 Selection.ShapeRange.Width = 129.6 End With With ActiveSheet.Shapes("PIC_RGA_CMP1_5") .Top = Range("RGA_COMP5_CELL").Top + (Range("RGA_COMP5_CELL").Height - .Height) / 2 .Left = Range("RGA_COMP5_CELL").Left + (Range("RGA_COMP5_CELL").Width - .Width) / 2 End With End If   End Sub 

Вот скриншот листа, куда вставляются картинки, показывающий, откуда читаются цифры:

Любые советы, чтобы ускорить это будет принята с благодарностью! Этот код должен выполняться до 10 таблиц, идентичных той, что на картинке. Спасибо!!!