Insert blank rows stops running

Try:

Please Login or Register  to view this content.

Regards, TMS

When you insert a row, I prefer to use a reverse loop: start from the last row and go up to row 1.

Like this :

Please Login or Register  to view this content.

Hi, Jeff,

I like the codeline

Please Login or Register  to view this content.

where the adding of 0 might be passed.

Basicly the same as before but using a Withstatement for teh AcitvSheet instead of repeating it:

Please Login or Register  to view this content.

Ciao,
Holger

I tried this way, uses the initial schema and goes on until the list if finished, HAHOBE fine humor about the a+0

Please Login or Register  to view this content.

Moderator Comment: Please read the forum rules regarding the use of code tags.

PHP Code: 

Option Explicit

Sub InsertBlankRows()
 Dim Cls As Range, Rng As Range, J As Long
 
 Set Rng = Range([a2], [a2].End(xlDown))
 Columns("A:A").Insert Shift:=xlToRight
 Union([A1], [A1].Offset(Rng.Rows.Count)).Value = "xxx.xxx"
 For Each Cls In Rng
    J = J + 1
    Cls.Offset(, -1).Value = "A" & Right("000" & CStr(J), 4)
    If Left(Cls.Value, 5) = "EV01_" Then
        Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = "A" & Right("000" & CStr(J), 4) & "1"
    End If
 Next Cls
 
 [A1].CurrentRegion.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 Columns("A:A").Delete Shift:=xlToLeft
End Sub