Sub InsertRows()
Dim LstRw As Long
Dim c As Object
Dim FirstAddress As String
LstRw = Cells(Rows.Count, "A").End(xlUp).Row
With Sheets("Sheet2").Range("A1:A" & LstRw)
Set c = .Find(What:="ATTR", LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
MsgBox ("'ATTR' not found in column A.")
Else
FirstAddress = c(2).Address
Do
c.EntireRow.Insert
Set c = .FindNext(c)
Loop While c.Address <> FirstAddress
End If
End With
End Sub