Insert blank rows stops running

I have this code which adds a blank row above the name "EV01_" where it appears.
...which works fine, but only works for half the rows

Sub lmsert_BlankRow_above()

For a = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    If ActiveSheet.Cells(a, 1).Value Like "EV01_*" Then
        ActiveSheet.Rows(a + 0).Insert
        a = a + 1
    End If
Next a
End Sub

If I have 10 rows where this name appears it adds a blank above the first 5, and leaves the remaining unchanged.
if i have 40 rows, it adds a blank row above the first 20.

any ideas how to correct this?

thanks

Jeff