Need Macro to insert a Specific number of Rows (in Filtered list)

I'm trying to insert a specific # of rows in a filtered list, for this example lets say 30.

I want my code to drop down 6 rows from the active cell, then insert Shift:=xlDown by 30 rows

My Code so far:

Please Login or Register  to view this content.

Only works if there are no filtered/hidden rows in the range defined by the above code "ActiveCell.Offset(6, 0).Range("A1", "A" & RowsToInsert)", or just "ActiveCell.Offset(6,0).range("A1:A30") ". If there are filtered out rows then it only inserts the visible number of rows in the defined range. So in this example since i've filtered out two, 6 row workpackages in the range, it will only insert 18 rows instead of 30.

I've also tried using Rows("1:30") instead of range(...) but that also produces the same result as using the range method. So the selecting a range, then inserting rows method seems to not work consistently with filtered lists and I need a work around.

Please see my attached work book and run or step into the InsertRows macro while A8 is the active cell to see what i mean.

The intent of this is to replace the For Next loop in my "add work package" macro that adds rows. Rather than inserting blocks of 6 rows at a time and looping which starts to take longer the larger and larger the sheet gets, i want to just insert the exact number of rows I need all at once which is much faster.

Right now the only alternative I can think of is a Do Until Loop that resizes the range selected until the number of visible rows in my selection = the number or rows i want to insert, however I'm hoping there is a faster, simpler and more elegant solution out there i'm missing other than using a loop.