'Make copy-paste code, triggered by button at different locations, faster

I made a model for our project managers to follow the economy in different projects.

A wish for the model was the option to add rows into the matrix I made without losing the formulas and subtotals within the scheme.
By copy-pasting and editing formulas from this site I made buttons throughout the matrix to add rows.

It is slow. Whenever they press one of my buttons it takes about 44 seconds for a new row to be added and the formulas etc. to be copy-pasted into the new row.

It looks like it is all the copy-paste steps that is the trouble.

Can I make this copy-paste-code faster?

I tried copying the range instead but I can't make that work, neither copying the entire row (it also pastes the button, which I would like it NOT to).

Sub Tilføj_række()
    
Dim b As Object, cs As Integer
Set b = ActiveSheet.Shapes(Application.Caller)
With b.TopLeftCell.EntireRow.Offset(1, 0)
    .Insert
    .Cells(1, 3).Copy .Cells(0, 3)
    .Cells(1, 4).Copy .Cells(0, 4)
    .Cells(1, 5).Copy .Cells(0, 5)
    .Cells(1, 6).Copy .Cells(0, 6)
    .Cells(1, 7).Copy .Cells(0, 7)
    .Cells(1, 8).Copy .Cells(0, 8)
    .Cells(1, 9).Copy .Cells(0, 9)
    .Cells(1, 10).Copy .Cells(0, 10)
    .Cells(1, 11).Copy .Cells(0, 11)
    .Cells(1, 12).Copy .Cells(0, 12)
    .Cells(1, 13).Copy .Cells(0, 13)
    .Cells(1, 14).Copy .Cells(0, 14)
    .Cells(1, 15).Copy .Cells(0, 15)
    .Cells(1, 16).Copy .Cells(0, 16)
    .Cells(1, 17).Copy .Cells(0, 17)
    .Cells(1, 18).Copy .Cells(0, 18)
    .Cells(1, 19).Copy .Cells(0, 19)
    .Cells(1, 20).Copy .Cells(0, 20)
    .Cells(1, 21).Copy .Cells(0, 21)
    .Cells(1, 22).Copy .Cells(0, 22)
End With
End Sub

A piece of my matrix looks like this where the green buttons are the triggers for the code.
enter image description here

The bold rows contains sum-functions.

I hope you geniuses can help me once more.

vbaperformancecopy


Solution 1:[1]

Sometimes the answer is so simply and right in front of you, that you overlook it....

Almost right after I gave up and posted this, I found the answer myself, so if someone is ever in the same trouble as I was, the answer is:

Sub Tilføj_række()
        
        Dim b As Object, cs As Integer
        Set b = ActiveSheet.Shapes(Application.Caller)
        With b.TopLeftCell.EntireRow.Offset(1, 0)
    .EntireRow.Copy
    .Insert
    
        End With

    
End Sub

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 Geert Bellekens

Related Questions