Vb lav ny række

Denne kode er lavet efter en anden kode "http://www.eksperten.dk/spm/743790"
men den laver ikke en ny række som den gamle koge gjore
den gamle kode gjore det ved hver værdi og ikke kun på "a" og "p"

Er der en som kan se hvor fejlen er

Sub Ny()
Dim x As Range
Cells(1, 1).Activate
Set x = ActiveCell
While x <> ""
While UCase(x.Offset(1, 0)) = "A" Or UCase(x.Offset(1, 0)) = "P" Or UCase(x.Offset(2, 0)) = "A" Or _
UCase(x.Offset(2, 0)) = "P" Or UCase(x.Offset(3, 0)) = "A" Or UCase(x.Offset(3, 0)) = "P" Or _
UCase(x.Offset(4, 0)) = "A" Or UCase(x.Offset(4, 0)) = "P"
x.Offset(1, 0).Rows.Insert
Wend
x.Offset(5, 0).Activate
Set x = ActiveCell
Wend
End Sub

Sub gammel()
    rw = Range("A65536").End(xlUp).Row
    For i = rw To 3 Step -1
        If Cells(i, 1) <> "" Then
            If Cells(i, 1).Offset(-1, 0) = "" And Cells(i, 1).Offset(-2, 0) = "" And Cells(i, 1).Offset(-3, 0) = "" Then
            Else
                Rows(i & ":" & i).Insert Shift:=xlDown
            End If
        End If
    Next

End Sub