Insert 4 Blank Rows in After Each Line

[feroz_bilal]

Hello,
I have data like this

a

b

c

d

e

f

g

h

i

j

<tbody>
</tbody>

And What I want to have is:

I would like to insert 4 blank lines after each line like this:

a

b

c

<tbody>
</tbody>

and so on....

Help will be highly appreciated.
Regards

 

[JLGWhiz]

Sub t()
Dim i As Long, lr As Long
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    For i = lr To 1 Step -1
            Cells(i + 1, 1).Resize(4, 1).EntireRow.Insert
    Next
End Sub

 

[feroz_bilal]

Hello ,
thank you very much for prompt reply but can u please explain me little cause i am new to vba processes.
Regards

 

[feroz_bilal]

Hello
brother i managed to do it....Thank you very much you solved my problem

 

[JLGWhiz]

Glad to help,
Regards, JLG

 

[feroz_bilal]

Sub t()
Dim i As Long, lr As Long
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = lr To 1 Step -1
Cells(i + 1, 1).Resize(3, 1).EntireRow.Insert
Next
End Sub

 

[MARK858]

So in your last post are you just saying that you only wanted 3 blank rows inserted after each line then not 4 and it is still solved?

I would like to insert 4 blank lines after each line like this:

 

[Rick Rothstein]

Just out of curiosity, how many columns of data do you have... just one as your original post seems to indicate or are there multiple columns of data? If there is only a single column of non-formula data, then there is a non-looping alternative that you could consider...

[table="width: 500"]
[tr]
	[td]Sub InsertThreeRowsBetweenSingleColumnOfData()
  Dim Temp As Variant
  Temp = Split(Join(Application.Transpose(Range("A1", Cells(Rows.Count, "A").End(xlUp))), vbLf & vbLf & vbLf & vbLf), vbLf)
  Range("A1").Resize(UBound(Temp) + 1) = Application.Transpose(Temp)
End Sub[/td]
[/tr]
[/table]

 

[kalak]

Or, if you've got real big data, say 200,000 rows or so, can try

Sub lotsa_data()

Const ins& = 3
Dim r, x, c(), a, i, s
With Range(Cells(1), Cells(Rows.Count, 1).End(xlUp))
    r = .Rows.Count
    x = ins + 1
    ReDim c(1 To x * r, 1 To 1)
    a = .Value
    .Clear
End With
For i = 1 To x * r Step x
    s = s + 1
    c(i, 1) = a(s, 1)
Next i
Cells(1).Resize(x * r) = c

End Sub

 

[Rick Rothstein]

Or, if you've got real big data, say 200,000 rows or so, can try....

Are you implying the code I posted in Message #8 would be slow with that many rows of data (confined to a single column)? When I test your code against mine for 200,000 random text strings in Column A, I get these results...

My Code: 0.05 seconds

Your Code: 0.06 seconds

The difference is probably not real and my guess is, on average, our two methods are equally fast.