Excel VBA для копирования нескольких строк и вставки в следующую строку в зависимости от нажатия кнопки

Question

В настоящее время я столкнулся с проблемой, когда я не могу правильно скопировать и вставить строки после нескольких нажатий кнопок.Логика, которую я хочу достичь, состоит в том, чтобы скопировать каждую строку, исключая заголовок, и добавить к следующей строке.Пожалуйста, обратитесь к предоставленному изображению.

Шаблон по умолчанию * Перед нажатием кнопки

После вставки из последней строки

Продолжайте вставлять в обычном режиме

В конечном итоге достигните этой точки

Ниже приведены мои коды, которые являются беспорядком.Я новичок в VBA, пожалуйста, помогите мне в этом, спасибо.

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

Если это то, что вы ищете *, макрос предполагает, что вы всегда будете поддерживать только одну пустую строку между каждым подразделом.Это скопирует последнюю строку в каждом подразделе и вставит ее ниже, сохранив одну пустую строку ниже перед следующей таблицей.

---

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