Hi

Try the following (I named my list Test)

Dim r As Object
Dim intCount As Integer
intCount = 1

For Each r In Range("Test")
If r.Value = "" Then

Else
r.Offset(1, 0).Select
intCount = 1
Do Until intCount 7
Selection.EntireRow.Insert
intCount = intCount + 1
Loop
End If

Next

--
BadgerM
-----------------------------------------------------------------------
BadgerMK's Profile: http://www.excelforum.com/member.php...fo&userid=3140
View this thread: http://www.excelforum.com/showthread.php?threadid=51538