插入行以用标题分隔数据组

有人可以帮我写这个脚本吗？

就目前情况而言，一旦值/文本发生更改并插入新行，当前的宏就会分离数据，但我只是无法弄清楚如何在插入行后包含标题。

Sub Insert Row()

Dim ws As Worksheet
Dim lr As Long
Dim i As Long

Set ws = Worksheets("Sheet1") 'the sheet with the data
lr = ws.Range("A" & Rows.Count).End(xlUp).Row 'last row with data in Column A
For i = lr - 1 To 2 Step -1
If ws.Range("A" & i).Value <> ws.Range("A" & i + 1).Value Then ws.Range("A" & i + 1).EntireRow.Insert
Next i

End Sub

提前谢谢您。

重复的标头

快速修复

Sub InsertHeaders()

    Const FIRST_ROW As Long = 1
    Const EMPTY_ROWS As Long = 1
    
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    Dim LastRow As Long: LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim r As Long
    
    For r = LastRow To FIRST_ROW + 2 Step -1
        With ws.Cells(r, "A")
            If .Value <> .Offset(-1).Value Then
                .EntireRow.Resize(EMPTY_ROWS + 1).Insert
                ws.Rows(1).Copy ws.Rows(.Row - 1)
            End If
        End With
    Next r

End Sub