Inserting Blank Cells

[whitefeather]

I have a simple table like

5569
3321
6347
7889

Now, I require to insert a fixed number of blank cells (say 5) after each of these populated cells. How to do so?

Thanks in advance.

 

[MickG]

Try:-

[COLOR="Navy"]Sub[/COLOR] MG21Dec40
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] n = Rng.Count To 1 [COLOR="Navy"]Step[/COLOR] -1
 Range("A" & n).Resize(5).Insert shift:=xlDown
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Gary's Student]

Assume the data is in column A, run this short macro:

Sub BlankInserter()
    Dim A As Range, i As Long, N As Long
    Dim j As Long
    
    Set A = Range("A:A")
    N = Cells(Rows.Count, "A").End(xlUp).Row
    
    For i = N To 2 Step -1
        For j = 1 To 5
            Cells(i, 1).Insert Shift:=xlDown
        Next j
    Next i
End Sub

 

[My Aswer Is This]

Assuming the values are in column "A" try this:

Sub Test()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    For i = Lastrow To 2 Step -1
        Rows(i).Resize(5).Insert
    Next
Application.ScreenUpdating = True
End Sub

OK

 

[Rick Rothstein]

This should also work...

[table="width: 500"]
[tr]
	[td]Sub InsertFiveRowsBetweenCells()
  With Range("A1", Cells(Rows.Count, "A").End(xlUp))
    .Cells(1).Resize(6 * .Count - 5) = Application.Transpose(Split(Join(Application.Transpose(.Cells), Space(6))))
  End With
End Sub[/td]
[/tr]
[/table]

 

[whitefeather]

All worked. Thank you very much. But, @rick rothstein's process yielded faster result. Thanks again.