insert rows

[brijesh]

1. i am having 1000 items no column wise i want to insert
11 rows after every item no
so for this please some help me

 

[Ken Wright]

Sub InsertBlankRows()

Application.ScreenUpdating = False

Dim numRows As Integer
Dim r As Long
Dim Rng As Range
Dim lastrw As Long
numRows = InputBox("How many Rows")

lastrw = Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Range(Cells(1, "A"), Cells(lastrw, "A"))

For r = Rng.Rows.Count To 1 Step -1
Rng.Rows(r + 1).Resize(numRows).EntireRow.Insert
Next r

Application.ScreenUpdating = True

End Sub

 

[Ken Wright]

And just in case you try to add too many rows:-

Sub InsertBlankRows()

Application.ScreenUpdating = False
Dim numRows As Long
Dim r As Long
Dim Rng As Range
Dim lastrw As Long
Dim n As Long
Dim rrc As Long
Dim rc As Long
Dim mn As Long

numRows = InputBox("How many Rows")

On Error Resume Next

lastrw = Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Range(Cells(1, "A"), Cells(lastrw, "A"))

rrc = Rng.Rows.Count
rc = Rows.Count
n = rrc * numRows
mn = Int(rc / rrc)

If n > rc Or rrc > rc / 2 Then GoTo ErrorMsg

For r = Rng.Rows.Count To 1 Step -1
Rng.Rows(r + 1).Resize(numRows).EntireRow.Insert
Next r

Application.ScreenUpdating = True
Exit Sub

ErrorMsg: MsgBox ("- The max number of rows you can run this with is 32,767" _
& vbCrLf & "- Your range contains " & rrc & " rows" _
& vbCrLf & "- The Max number of blank rows you can insert" _
& " on this range is " & mn - 1 & " rows per line of data" _
& vbCrLf & "- Try again with fewer rows")
InsertBlankRows

End Sub