Trying to insert rows.

[Cree]

All,

I'm trying to insert rows between some printed bar codes.

I've uploaded the Excel file along with a word doc that illustrates what I'm trying to accomplish.

The Excel file has 2 tabs. One is named "Main" and the other is named "Traveler".
On the "Main" tab, there is a "Create Files" button, when this is pressed, it creates files outside of the
Excel spreadsheet, but also populates the "Traveler" tab with file names along with bar codes.
To facilitate the scanning of the bar codes, I'd like to insert one or two blank rows in between each one.
A contractor created the Excel file to create our "Main" programs which are utilized in a CNC manufacturing cell.
I've done some minor edits to it, but I'm unable to figure out how to insert the blank rows.
Note that I have very little VB knowledge, so I'm looking for some help trying to figure this out.
Any help would be appreciated.

Thanks,

[protonLeah]

Option Explicit
Sub InsertRows()
    Dim LastRow As Long, _
        NewRow  As Long
    
    Const FirstRow As Long = 9
    
    LastRow = Cells(Rows.Count, "a").End(xlUp).Row
    
    For NewRow = LastRow To FirstRow Step -1
        Range("A" & NewRow).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Next NewRow
End Sub

[Cree]

Thanks for the reply.
When I use this code, it inserts multiple rows.
Anywhere from 10 too 18, doesn't seem to be consistent.
How can I contain it to just add 2 rows between each bar code line?

Thanks,

[protonLeah]

Well, unless your actual sheet is different from the posted sample, the original code can't insert random numbers of rows. It only pushes the currently active row down one row. The new code copies the first two blank rows below the data and pastes it in pushing the last row down two, moves up the the next row, copies the two blanks just pasted... tested on the sample provided.

Option Explicit
Sub InsertRows()
    Dim LastRow As Long, _
        NewRow  As Long
    
    Const FirstRow As Long = 9
    
    LastRow = Cells(Rows.Count, "a").End(xlUp).Row
    
    'start at the last row
    For NewRow = LastRow To FirstRow Step -1
        
        'copy the first two blank rowsbelow the data
        Range("A" & NewRow).Offset(1, 0).Resize(2).EntireRow.Copy
        
        'insert the two blank rows
        Range("A" & NewRow).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Next NewRow
    Application.DataEntryMode = False
    Range("A1").Select
End Sub