试试这个代码

Sub Test()
Dim a()         As Variant
Dim found       As Range
Dim fStr        As String
Dim fAdd        As String
Dim i           As Long

fStr = "HDR"
Set found = Cells.Find(What:=fStr, After:=Range("A1"), LookIn:=xlValues, LookAt:=xlWhole)

If Not found Is Nothing Then
    fAdd = found.Address

    Do
        ReDim Preserve a(i)
        a(i) = found.Offset(1).Address
        i = i + 1
        Set found = Cells.FindNext(found)
    Loop Until found.Address = fAdd
End If

If i = 0 Then Exit Sub
For i = UBound(a) To LBound(a) Step -1
    Range(a(i)).EntireRow.Insert
Next i
End Sub

另一个选择

Sub Test()
Dim a()         As Variant
Dim oRange      As Range
Dim found       As Range
Dim fStr        As String
Dim fAdd        As String

fStr = "HDR"
Set found = Cells.Find(What:=fStr, After:=Range("A1"), LookIn:=xlValues, LookAt:=xlWhole)

If Not found Is Nothing Then
    fAdd = found.Address

    Do
        If oRange Is Nothing Then Set oRange = found.Offset(1) Else Set oRange = Union(oRange, found.Offset(1))
        Set found = Cells.FindNext(found)
    Loop Until found.Address = fAdd
End If

If Not oRange Is Nothing Then oRange.EntireRow.Insert
End Sub

Sub NewRowInsert()

    Dim SearchText As String
    Dim GCell As Range
    Dim NumSearches As Integer
    Dim i As Integer

    SearchText = "HDR"
    NumSearches = WorksheetFunction.CountIf(Cells, SearchText)
    Set GCell = Cells(1, 1)

    For i = 1 To NumSearches

        Set GCell = Cells.Find(SearchText, After:=GCell, SearchOrder:=xlByRows, SearchDirection:=xlNext).Offset(1)
        GCell.EntireRow.Insert

    Next i

 End Sub