Excel VBA to copy multiple rows and insert to next row depending on button click

Question

I am currently facing a problem where I am not able to copy and insert the rows correctly after few button clicks. The logic I want to achieve is to copy each rows excluding the header and append to next row. Please refer to the image provided.

Default Template *Before button click

After inserting from last row

Continue to insert normally

Eventually will reach to this point

Below are my codes which is a mess. I am new to VBA, please guide me in this, Thank you.

Sub bt_add()

Dim a1 As Integer
Dim a2 As Integer
Dim a3 As Integer
Dim a4 As Integer
Dim a5 As Integer
Dim a6 As Integer
Dim a7 As Integer
Dim a8 As Integer
Dim a9 As Integer
Dim a10 As Integer
Dim a11 As Integer
Dim a12 As Integer
Dim n As Integer
Dim s As Integer

Static clicked As Integer

a1 = 2
a2 = 3
a3 = 6
a4 = 7
a5 = 10
a6 = 11
a7 = 14
a8 = 15
a9 = 18
a10 = 19
a11 = 22
a12 = 23

n = clicked
s = clicked + 1

If clicked = 0 Then
    a1 = 2
    a2 = 3
    a3 = 6
    a4 = 7
    a5 = 10
    a6 = 11
    a7 = 14
    a8 = 15
    a9 = 18
    a10 = 19
    a11 = 22
    a12 = 23

    clicked = clicked + 1
Else
    If clicked >= 2 Then
        a1 = a1 + n
        a2 = a2 + n
        a3 = a2 * 2
        a4 = a2 * 2 + 1
        a5 = a5 + n + 1 + s
        a6 = a6 + n + 1 + s
        a7 = a7 + n + 3 + s
        a8 = a8 + n + 3 + s
        a9 = a9 + n + 5 + s
        a10 = a10 + n + 5 + s
        a11 = a11 + n + 7 + s
        a12 = a12 + n + 7 + s

        clicked = clicked + 1
    Else
        a1 = a1 + n
        a2 = a2 + n
        a3 = a2 * 2
        a4 = a2 * 2 + 1
        a5 = a5 + n + 2
        a6 = a6 + n + 2
        a7 = a7 + n + 3
        a8 = a8 + n + 3
        a9 = a9 + n + 4
        a10 = a10 + n + 4
        a11 = a11 + n + 5
        a12 = a12 + n + 5

        clicked = clicked + 1
    End If

End If



'MsgBox a1 & ", " & a2 & ", " & a3 & ", " & a4 & ", " & a5 & ", " & a6 & ", " & a7 & ", " & a8 & ", " & a9 & ", " & a10 & ", " & a11 & ", " & a12 & ", " & n & ", " & s

Selection.Copy
Rows(a1).EntireRow.Copy
Rows(a2).Select
Selection.Insert Shift:=xlDown
Rows(a3).EntireRow.Copy
Rows(a4).Select
Selection.Insert Shift:=xlDown
Rows(a5).EntireRow.Copy
Rows(a6).Select
Selection.Insert Shift:=xlDown
Rows(a7).EntireRow.Copy
Rows(a8).Select
Selection.Insert Shift:=xlDown
Rows(a9).EntireRow.Copy
Rows(a10).Select
Selection.Insert Shift:=xlDown
Rows(a11).EntireRow.Copy
Rows(a12).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False

End Sub

Answer 1

Ifthis is what you are looking for*, the macro assumes you will always maintain only one blank row between each subsection. This will copy the last row in each subsection and insert it below while preserving the 1 blank row below before the next table.

---

Option Explicit

Sub InsertRows()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim i As Long, LR As Long

LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1).Row

'Application.ScreenUpdating = False
    For i = LR To 1 Step -1
        If ws.Range("A" & i) = "" Then
            ws.Range("A" & i + 1).EntireRow.Insert
            ws.Range("A" & i - 1).EntireRow.Copy ws.Range("A" & i)
        End If
    Next i
'Application.ScreenUpdating = True

End Sub