Macro needed to insert blank rows below row based on value in cell in row

**lauragoodwin** · 02-01-2015, 02:31 AM

Hello,
New to forum and each month I need to create an extremely large spreadsheet and need a macro does the following:
I need a macro that will look the value in B2 and insert the number of rows in cell b2 below the row.

ColumnA ColumnB ColumnC ColumnD
Row2 14 xxx yyyy
Row3 444 aaa bbbb
Row4 68 zzz rrrrr

Under Row 2 I need 14 rows inserted, then move to (previously row3, now row15 due to previously inserted 14 rows) and insert 444 rows etc. Once rows are inserted I want to copy the values in Column A, C and D into the number of inserted rows so that it would look like this:

ColumnA ColumnB ColumnC ColumnD
Row2 14 xxx yyyy
Row2 xxx yyyy
Row2 xxx yyyy
Row2 xxx yyyy
Row2 xxx yyyy
Row2 xxx yyyy
Row2 xxx yyyy
Row2 xxx yyyy
Row2 xxx yyyy
Row2 xxx yyyy
Row2 xxx yyyy
Row2 xxx yyyy
Row2 xxx yyyy
Row2 xxx yyyy
Row2 xxx yyyy
Row3 444 aaa bbbb
Row3 aaa bbbb
Row3 aaa bbbb
Row3 aaa bbbb
Row3 aaa bbbb
Row3 aaa bbbb
Row3 aaa bbbb
Row3 aaa bbbb
Row3 aaa bbbb
Row3 aaa bbbb

Hoping someone can help because it will save me about 4 hours of work.
Thanks so much
L

**Crooza** · 02-01-2015, 06:05 AM

Hi and Welcome.

Try this

Sub insertrows()
Dim rowcount, rownum, insertnum, i As Integer
rowcount = Application.CountA(Range("A:A")) - 1

rownum = 2
insertnum = 0

For i = 1 To rowcount + 1

insertnum = Range("b1").Offset(rownum - 1, 0).Value

Rows(rownum + 1 & ":" & rownum + insertnum).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    
Range("A" & rownum & ":D" & rownum).Select
Selection.Copy
Range("A" & rownum & ":A" & rownum + insertnum).Select
ActiveSheet.Paste
    
rownum = rownum + insertnum + 1

Next i

End Sub

**lauragoodwin** · 02-02-2015, 12:41 PM

You're my hero! Thank you it worked perfectly.

Macro needed to insert blank rows below row based on value in cell in row

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Macro needed to insert blank rows below row based on value in cell in row

Re: Macro needed to insert blank rows below row based on value in cell in row

Re: Macro needed to insert blank rows below row based on value in cell in row

Thread Information

Users Browsing this Thread

Similar Threads

[SOLVED] Excel Macro, VBA help needed - Insert Cell based on value of a cell in another column

[SOLVED] Macro to Insert blank rows based on condition

Insert 2 blank rows and sum columns based on cell value change

insert a blank rows based on cell value

Macro to insert blank rows based on data above

Bookmarks

Bookmarks

Posting Permissions