1
votes

The code below automatically inserts specified rows in the Excel Worksheet, I need this code to also replicate the data from only some cells in the inserted row from the previous row. In, other words, in the data (image attached), the code below adds blank rows above the active cell. What I also need is the code to replicate the data from Columns Sales_ID and Sales_market into the inserted rows.

Screenshot of Worksheet

e.g. If I am adding rows above Customer 4 (highlighted in yellow in the data), the code would replicate the Sales_ID 1234 and Sales_market Canada into the inserted rows. The other cells for Customers and Customer_ID in the inserted rows should be blank.

Sub Multiplerows4()
  Dim rng As Integer
  Dim k As Integer
  Dim rRange As Range

  Set rRange = Selection

  rng = InputBox("Enter number:.")
  For k = 1 To rng
    Rows(rRange.Row).Insert Shift:=xlDown, _
      CopyOrigin:=xlFormatFromLeftOrAbove
  Next
End Sub
2

2 Answers

1
votes

Consider adding a second backwards stepping loop to update the inserted rows. Below assumes Sales_ID and Sales_Market are in the first and second columns (adjust accordingly):

Sub Multiplerows4()
    Dim rng As Integer, k As Integer
    Dim rRange As Range
    Dim salesID As Long, salesMkt As String

    Set rRange = Selected

    salesID = Cells(rRange.Row, 1)
    salesMkt = Cells(rRange.Row, 2)

    rng = InputBox("Enter number:.")
    For k = 1 To rng
        Rows(rRange.Row).Insert Shift:=xlDown, _
                                CopyOrigin:=xlFormatFromLeftOrAbove
    Next k

    For k = rng To 1 Step -1
        Cells(rRange.Row - k, 1) = salesID
        Cells(rRange.Row - k, 2) = salesMkt
    Next k

End Sub
0
votes

Here is the modified version of code with help from Parfait that is working for my purposes -

Sub Multiplerows()
Dim rng As Integer, k As Integer
Dim rRange As Range
Dim salesID As Long, salesMkt As String

Set rRange = Selection
rng = InputBox("Enter number:.")
For k = 1 To rng
    Rows(rRange.Row).Insert Shift:=xlDown, _
                            CopyOrigin:=xlFormatFromLeftOrAbove
Next k
   For k = rng To 1 Step -1
Cells(rRange.Row - k, 1) = Cells(rRange.Row, 1)
Cells(rRange.Row - k, 2) = Cells(rRange.Row, 2)
   Next k
End Sub