Insert rows based on the current cell value and, then, copy some cells into the new rows

Hello All,

I am a fairly experienced Excel user, but new to VBA and macros. I have recorded some macros and done a bit of editing of the VBA code.

I am trying to create a macro that will, based on the value of the current cell, insert X minus 1 new rows below the current row, where X is the value of the current cell and, then, copy some cells from the current row straight down into the new blank rows.

For example, if the data is located in the range J10:O13 as follows and J10 is the starting cell:

___J__K__L__M__N__O

10__3__X__X__X__X__X
11__2__X__X__X__X__X
12__3__X__X__X__X__X
13__1__X__X__X__X__X


The macro would change the data to:

___J__K__L__M__N__O

10__3__X__X__X__X__X
11_____X__X__X__X__X
12_____X__X__X__X__X
13__2__X__X__X__X__X
14_____X__X__X__X__X
15__3__X__X__X__X__X
16_____X__X__X__X__X
17_____X__X__X__X__X
18__1__X__X__X__X__X


Note: I had to include the underscores above just to get the columns to line up. Only the cells in columns K thru O are copied down into the new rows, not the cells in column J.


I did find the following macro which works perfectly to insert the new rows, but I cannot seem to add the proper code to get the specified cells from the current row to copy down into the new cells:

Sub Insert_Rows()
'
' Insert_Rows Macro
'
' Keyboard Shortcut: Ctrl+i
'
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

I have read that it is better to start at the bottom of the data and move up when inserting rows and I do wonder if that may be related to my problem of not getting the copy/paste to work properly.

Here is the code that I tried to add for copying and pasting:

ActiveCell.Offset(0, 1).Range("A1:K1").Select
            Selection.Copy
            ActiveCell.Offset(1, 0).Range("A1:K3").Select
            ActiveSheet.Paste

It does copy and paste, but the pasted data keeps shifting one column to the right each time the macro loops.

Thanks for any help anyone can provide!

RZ

can you attach a sample file with data and desired result ?

Hi, Excel-RZ,

please wrap your code in Code-Tags when showing your preocedures here in Exccel-Forum.

You result is showing an error as row 19 should not be filled.

Maybe try this code

Sub EF965720()
Dim lngCounter As Long

For lngCounter = Range("J" & Rows.Count).End(xlUp).Row To 10 Step -1
  With Cells(lngCounter, "J")
    If .Value > 1 Then
      With .Offset(1, 0).Resize(.Value - 1, 1)
        .EntireRow.Insert
      End With
      Range("K" & lngCounter + 1).Resize(.Value - 1, 5).Value = Range("K" & lngCounter & ":O" & lngCounter).Value
    End If
  End With
Next lngCounter
End Sub

@patel45:
I think both original set as well as result have been given in the opening post.

Ciao,
Holger

Hi, Excel-RZ,

no need to fully quote any of the other posts when you answer to them - you should reduce the quotation to only the necessary parts.

In the opening post the range starts at Row 10y in the sample you supplied at Row 18 - if you didnīt alter the end of the loop from 10 to 18 to me that explains the run-time error when in Row 16 text is found.This may be avoided by altering the code to

Sub EF965720_2()
Dim lngCounter As Long

For lngCounter = Range("J" & Rows.Count).End(xlUp).Row To 10 Step -1
  With Cells(lngCounter, "J")
    If IsNumeric(.Value) And .Value > 1 Then
      With .Offset(1, 0).Resize(.Value - 1, 1)
        .EntireRow.Insert
      End With
      Range("K" & lngCounter + 1).Resize(.Value - 1, 5).Value = Range("K" & lngCounter & ":O" & lngCounter).Value
    End If
  End With
Next lngCounter
End Sub

Ciao,
Holger

RZ: Welcome to the forum, unfortunately.......

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here



(I have added them for you today. Please read all our rules and abide by them in the future.)