Hi Mark,

Am Tue, 7 Aug 2018 02:45:51 -0700 (PDT) schrieb Living the Dream:

No idea why it posted when I wasn't finished, but! here we go again:

For each c in myRng
If Not c = "" then
with c
.Resize(6).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.offset(7, 0).select
End with
End if
Next c

try:

Sub InsertRows()
Dim LRow As Long, i As Long

With ActiveSheet
LRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LRow To 2 Step -1
.Rows(i).Resize(6).Insert
.Range(.Cells(i, 1), .Cells(i + 5, 1)).Value = .Cells(i + 6, 1).Value
Next
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016