VBA代码，用于复制标题及以上小计组

我一直在尝试创建一个宏来复制标题并插入所有小计组。所以所有小计组都有一个标题。我尝试了下面的宏，但它不起作用

Sub header()

Rows("1:1").Select

Selection.Copy

Dim Col As Variant
Dim BlankRows As Long
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long

Col = "P"
StartRow = 1
BlankRows = 1

LastRow = Cells(Rows.Count, Col).End(xlUp).Row

Application.ScreenUpdating = False

With ActiveSheet
    For R = LastRow To StartRow + 1 Step -1
        If .Cells(R, Col) = "Total" Then
            .Cells(R+1, Col).EntireRow.Insert Shift:=xlDown
        End If
    Next R
End With
Application.ScreenUpdating = True

End Sub

---

尝试以下方法。有几个调整：

1） 我修正了缩进。也许是品味的问题，但我发现如果代码没有逻辑缩进，就很难阅读

2） 我将前两行替换为第（1）行。复制。没有理由选择某个东西来复制它（而且1作为索引比“1:1”更惯用）

3） 插入行的操作完成复制粘贴操作。因此，在插入操作之后，我重新复制了标题行。这解决了您的实际问题

4） 循环中的最后一个副本使Excel仍在寻找粘贴标题行的位置。Application.CutCopyMode=错误地址

Sub header()

    Rows(1).Copy
    Dim s As Range

    Dim Col As Variant
    Dim BlankRows As Long
    Dim LastRow As Long
    Dim R As Long
    Dim StartRow As Long

    Col = "P"
    StartRow = 1
    BlankRows = 1

    LastRow = Cells(Rows.Count, Col).End(xlUp).Row

    Application.ScreenUpdating = False

    With ActiveSheet
        For R = LastRow To StartRow + 1 Step -1
            If .Cells(R, Col) = "Total" Then
                .Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
                Rows(1).Copy
            End If
        Next R
    End With
    Application.ScreenUpdating = True
    Application.CutCopyMode = False

 End Sub

---

请编辑你的帖子来解释它是如何工作的。嗨，约翰，谢谢你的回复。我是一个新的孩子在编码，我试图拿起像'适当的意图'的习惯。谢谢你这么说。上面的代码不起作用首先我发现了问题所在，我的工作表小计单元格中不仅包含单词“Total”。如何将条件更改为“If the cell contains word Total insert the heading”我试图将“If.Cells（R，Col）=“Total”Then”替换为If InStr（1，（Range（“P2:P&Count11”）.Value），“Total”）>1，但它给出了400个错误。Thnks要获得帮助，我解决了这个问题。。现在工作得很好，又来了