Private Sub CommandButton1_Click()

    Dim objFind As Range
    Dim lngRow As Long
    Dim lngRows() As Long
    Dim lngLastRow As Long
    Dim strFirstAddress As String
    Dim strHeaderKeyWord As String
    Dim lngFirstRow As Long
    
    lngLastRow = ThisWorkbook.Worksheets( 1 ).Range("A65536").End(xlUp).Row
    strHeaderKeyWord = "Шапка Моя"
    
'предполагаем шапки в колонке А

    With ThisWorkbook.Worksheets( 1 ).Range("A1:A" & CStr(lngLastRow)) 
            
        Set objFind = .Find(strHeaderKeyWord, LookIn:=xlValues, LookAt:=xlPart)
            
        If Not objFind Is Nothing Then
            lngFirstRow = objFind.Row
        End If
            
    End With
    
    With ThisWorkbook.Worksheets( 1 ).Range("A" & CStr(lngFirstRow +  1 ) & ":A" & CStr(lngLastRow))
        Set objFind = .Find(strHeaderKeyWord, LookIn:=xlValues, LookAt:=xlPart)
        
        If Not objFind Is Nothing Then
            strFirstAddress = objFind.Address
            Do
                ReDim Preserve lngRows(lngRow)
                 lngRows(lngRow) = objFind.Row
                Set objFind = .FindNext(objFind)
                lngRow = lngRow +  1 
            Loop While Not objFind Is Nothing And strFirstAddress <> objFind.Address
        End If
    
    End With

    For lngRow = UBound(lngRows) To LBound(lngRows) Step - 1 
         ThisWorkbook.Worksheets( 1 ).Rows(lngRows(lngRow)).Delete
    Next lngRow
End Sub