Tipps zum Beschleunigen von Code, der Bilder kopiert / einfügt?

Dies ist mein erstes Projekt mit VBA. Ich habe einen Code (siehe unten), der liest, wenn eine Zahl auf dem Blatt vorhanden ist. Wenn dies der Fall ist, ruft der Code ein Makro auf, um das Quellbild aus einem anderen Arbeitsblatt zu kopieren, auf dem neuen Arbeitsblatt einzufügen und das eingefügte Bild in der Zelle umzubenennen / die Größe zu ändern / zu zentrieren.

Das Problem ist, ich kann bereits sagen, dass dieser Code langsam läuft. Ich weiß, dass die Verwendung von ".select" den Code verlangsamt, aber ich weiß nicht, ob es für das, was ich tun muss, ein Problem gibt.

Hier ist der funktionierende (wenn auch langsame) Code, den ich habe. (scrollen Sie nach unten für ein Referenzbild)

Dies ist der erste Code, der die Nummern testet und die Makros aufruft:

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  

Hier ist ein Teil des Makros, das es aufruft:

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 

Hier ist ein Screenshot des Blattes, in das die Bilder eingefügt werden, das zeigt, wo die Zahlen gelesen werden:

Irgendwelche Tipps, um dies zu beschleunigen, wären sehr dankbar! Dieser Code muss an bis zu 10 Tabellen ausgeführt werden, die mit dem im Bild identisch sind. Vielen Dank!!!