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

A few months ago i made a model for our project managers to follow the economy in differenct projects.

A wish for the model was the option to add extra rows into the matrix i made without losing the formulas and subtotals within the scheme. By copy-pasting and editing formulas from this forum i made some buttons thoughout the matrix at different points so that they could add additional rows, and i got it to work as intended after a while (I'm a newbie at VBA, so it took a little time for me to figure out how).

The problem is: IT IS REALLY 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. And when you have to do that maybe 20 times its annoying..

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

So i was wondering can i make this copy-paste-code faster? I've tried copyin the range insted but i cant 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 image

The bold rows contains sum-functions

I hope you geniuses can help me once more

CodePudding user response：

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