+ Reply to Thread
Results 1 to 2 of 2

Insert Multiple Rows Based Off Number in Cell and Copy Data From Above New Rows

  1. #1
    Registered User
    Join Date
    10-01-2012
    Location
    Louisiana
    MS-Off Ver
    Excel 2010
    Posts
    2

    Insert Multiple Rows Based Off Number in Cell and Copy Data From Above New Rows

    Hi, I would really appreciate if someone could help me with the following:

    I need a macro to insert multiple rows based off a number in a cell, and then copy the information from the cell above it. For example, if cell M33 has a "3" in it, I want to add two rows below it and copy the information from the entire M33 row and paste the information into the two new rows. I want it to continue to do this for all of column M where the number "3" is found. I need to be able to adjust the macro for other numbers in column. For instance, if there is a "4" I want to insert three rows and copy the data from the row above into the three new rows. I attached a sample of the workbook that I am using.

    Thanks,

    tstell1
    Attached Files Attached Files
    Last edited by tstell1; 10-02-2012 at 04:18 PM.

  2. #2
    Registered User
    Join Date
    10-01-2012
    Location
    Louisiana
    MS-Off Ver
    Excel 2010
    Posts
    2

    Re: Insert Multiple Rows Based Off Number in Cell and Copy Data From Above New Rows

    I found the macro that I was looking for on another website.

    I used the following macro to insert blank rows dependent upon the value in the cell selected:

    Sub TryThis()
    Dim i As Integer, n As Integer, m As Long, currentCell As Range
    Set currentCell = ActiveCell
    Do While Not IsEmpty(currentCell)
    n = currentCell.Value - 1
    m = currentCell.Row
    If n > 0 Then
    Rows(m + 1 & ":" & m + n).Insert
    Set currentCell = currentCell.Offset(n + 1, 0)
    Else
    Set currentCell = currentCell.Offset(1, 0)
    End If
    Loop
    End Sub
    And the following macro to copy infromation from the above cell into the blank cells that I inserted.

    Sub FillInBlankCellsInColumns()

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Dim MyCounter As Long
    MyCounter = 0
    For Each r In Selection
    On Error Resume Next
    If r.Value = "" Then
    r.Value = r.Offset(-1, 0).Value
    End If
    Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    End Sub

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1