Macro to insert "X" number of rows between items in a list

I have a list of 100+ items and I would like insert 52 rows between each item in my list. I know this is probably pretty straightforward, but I don't have the time to figure it out and I know someone on here can help pretty quickly.

I've attached an example of my list.
Who is Participating?
Ken ButtersConnect With a Mentor Commented:
Here is code... need to run InsertLines Macro.

I have variable set to 52... you can change that if you want different number of lines inserted.

Public Sub InsertLines()

Dim myLastCell As Range
Dim i As Long
Dim ws As Worksheet

Dim numRowsToInsert As Long

numRowsToInsert = 52

Set ws = Worksheets("Sheet1")
Set myLastCell = LastCell(ws)

For i = myLastCell.Row To 2 Step -1
    ws.Rows(i & ":" & i + numRowsToInsert).Insert shift:=xlDown

End Sub

Function LastCell(ws As Worksheet) As Range

' Note "&" denotes a long value; "%" denotes an integer value
    Dim LastRow&, lastCol%

' Error-handling is here in case there is not any
' data in the worksheet

    On Error Resume Next

    With ws

  ' Find the last real row

    LastRow& = .Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _

  ' Find the last real column

    lastCol% = .Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _

    End With

' Finally, initialize a Range object variable for
' the last populated row.
    Set LastCell = ws.Cells(LastRow&, lastCol%)

End Function

Open in new window

NorieVBA ExpertCommented:
This will insert 52 rows between each row.
Dim rng As Range

    Set rng = Range("A2")


        rng.Offset(1).Resize(52).Insert xlShiftDown

        Set rng = rng.Offset(53)

    Loop Until rng.Value = ""

Open in new window

This will insert 52 rows whenever there's a change in value.
Dim rng As Range

    Set rng = Range("A2")


        If rng.Value <> rng.Offset(1).Value Then
            rng.Offset(1).Resize(52).Insert xlShiftDown
               Set rng = rng.Offset(52)
        End If
        Set rng = rng.Offset(1)

    Loop Until rng.Value = ""

Open in new window

thomas-sherrouseAuthor Commented:
Thanks - Got what I needed!
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.