Excel VBA - Copy Data to Blank Rows After Blanks Rows Inserted Between Data?

[MEUserII]

I am looking to see if anyone might have a macro for data that has blank rows inserted between data?

For example beginning with this:
[TABLE="width: 100"]
<tbody>[TR]
[TD][/TD]
[TD]Column_A[/TD]
[TD]Column_B[/TD]
[TD]Column_C[/TD]
[TD]Column_D[/TD]
[TD]Colum_E[/TD]
[/TR]
[TR]
[TD]Row_1[/TD]
[TD]ALPHA[/TD]
[TD]APPLE[/TD]
[TD]ABC[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Row_2[/TD]
[TD]BETA[/TD]
[TD]ORANGE[/TD]
[TD]DEF[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Row_3[/TD]
[TD]GAMMA[/TD]
[TD]KIWI[/TD]
[TD]GHI[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Row_4[/TD]
[TD]DELTA[/TD]
[TD]COCONUT[/TD]
[TD]JKL[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Row_5[/TD]
[TD]ECHO[/TD]
[TD]LIME[/TD]
[TD]MNO[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Row_6[/TD]
[TD]FRANK[/TD]
[TD]LEMO[/TD]
[TD]PQR[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I use the following insert blank rows macro to insert three blank rows:

Sub INSERTBLANKROWS()


Dim j As Long
Dim r As Range


j = InputBox("Enter the number of rows to be inserted")

Set r = Range("A1")
Do While r.Value <> ""
    Set r = r.Offset(1, 0)
    For i = 1 To j
        r.EntireRow.Insert
    Next
Loop


End Sub

And now need to copy the data from each "data row" to the blank rows inserted to end up with the following:
[TABLE="width: 100"]
<tbody>[TR]
[TD][/TD]
[TD]Column_A[/TD]
[TD]Column_B[/TD]
[TD]Column_C[/TD]
[TD]Column_D[/TD]
[TD]Colum_E[/TD]
[/TR]
[TR]
[TD]Row_1[/TD]
[TD]ALPHA[/TD]
[TD]APPLE[/TD]
[TD]ABC[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Row_2[/TD]
[TD]ALPHA[/TD]
[TD]APPLE[/TD]
[TD]ABC[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Row_3[/TD]
[TD]ALPHA[/TD]
[TD]APPLE[/TD]
[TD]ABC[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Row_4[/TD]
[TD]ALPHA[/TD]
[TD]APPLE[/TD]
[TD]ABC[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Row_5[/TD]
[TD]BETA[/TD]
[TD]ORANGE[/TD]
[TD]DEF[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Row_6[/TD]
[TD]BETA[/TD]
[TD]ORANGE[/TD]
[TD]DEF[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Row_7[/TD]
[TD]BETA[/TD]
[TD]ORANGE[/TD]
[TD]DEF[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Row_8[/TD]
[TD]BETA[/TD]
[TD]ORANGE[/TD]
[TD]DEF[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

What macro would I use to be able to do this?

 

[Rick Rothstein]

Give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub AddFillThreeRows()
  Dim R As Long, LR As Long, LC As Long, HowManyRows As Long
  Application.ScreenUpdating = False
  ' Insert Rows
  HowManyRows = Application.InputBox("Enter the number of rows to be inserted:", Type:=1)
  If Len(HowManyRows) Then
    For R = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
      Rows(R).Resize(HowManyRows).Insert
    Next
    ' Fill Empty Cells
    LR = Cells(Rows.Count, "A").End(xlUp).Row + HowManyRows
    LC = Cells(1, Columns.Count).End(xlToLeft).Column
    With Range("A1", Cells(LR, LC))
      .SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
      .Value = .Value
    End With
  End If
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]

 

[MEUserII]

Give this macro a try...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub AddFillThreeRows()
  Dim R As Long, LR As Long, LC As Long, HowManyRows As Long
  Application.ScreenUpdating = False
  ' Insert Rows
  HowManyRows = Application.InputBox("Enter the number of rows to be inserted:", Type:=1)
  If Len(HowManyRows) Then
    For R = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
      Rows(R).Resize(HowManyRows).Insert
    Next
    ' Fill Empty Cells
    LR = Cells(Rows.Count, "A").End(xlUp).Row + HowManyRows
    LC = Cells(1, Columns.Count).End(xlToLeft).Column
    With Range("A1", Cells(LR, LC))
      .SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
      .Value = .Value
    End With
  End If
  Application.ScreenUpdating = True
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

Thanks for the reply although this code did not seem to work all that well for me. I actually ended it up figuring out my own solution to this problem, and have posted my code below:

Sub copyRowToBelow() 

    Dim rng As Range
    Set rng = Range("A1") ' <~~  Change this

    Do While (rng.Row < 461) 'This value represents total number of rows after first macro created blank rows, so it serves as the upper limit.
        ' Insert a row below the current one
        'rng.Offset(1).Insert

        ' Copy the current row and paste it into the row we just inserted

rng.EntireRow.Copy rng.Offset(1)
rng.EntireRow.Copy rng.Offset(2)

        ' Set the range declaration for 3 rows below the current one
        Set rng = rng.Offset(3)
        
    Loop
   
End Sub

The only thing I am stuck on now is along with the first code that references the input: "j = InputBox("Enter the number of rows to be inserted")"; how to the adjust the code I listed above to dynamically work with the same input, "j". In other words, If "j = 6" is inputted in the first portion of code; then how to update the code listed above to use that same input "j" and copy the data to the same number "j" blanks rows inserted?