Hello,
I was trying to figure out how to do the following:
For each row:
1. Scan for the integer value found under column "I" on "Worksheet" (titled rows to duplicate).
2. Copy that row (with specific columns - highlighted in yellow)
3. Go to other sheet, insert rows to match the integer value
4. Paste copied row to inserted rows
5. Apply all borders
Repeat for next row
Here's the code for the attached worksheet. I was trying to get it to work but it is a bit clunky. Can anyone help out?
Sub InsertWorksheetRows()
Dim wsCopyFrom As Worksheet
Dim wsCopyTo As Worksheet
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lastrow_fws As Long
Dim N_of_rows As Long
Dim currentRow As Integer
Dim i As Integer
Dim currentNewSheetRow As Integer: currentNewSheetRow = 1
Set wsCopyFrom = Worksheets("Worksheet")
Set wsCopyTo = Worksheets("Testing_grounds")
wsCopyFrom.Activate
Firstrow = Application.WorksheetFunction.Match(("Order"), wsCopyFrom.Range("A:A"), 0)
Lastrow = Application.WorksheetFunction.Match(("Total"), wsCopyFrom.Range("G:G"), 0)
N_of_rows = Range(Cells(Firstrow, 1), Cells(Lastrow, 1)).Rows.Count
For currentRow = 3 To N_of_rows 'The last row of your data
Dim timesToDuplicate As Integer
timesToDuplicate = CInt(wsCopyFrom.Range("I" & currentRow).Value)
For i = 1 To timesToDuplicate
wsCopyTo.Activate
Lastrow_fws = Application.WorksheetFunction.Match(("Total"), Range("AA:AA"), 0) - 1 + 1
wsCopyTo.Cells(Lastrow, 1).EntireRow.Insert
'Row fill color
wsCopyTo.Cells(ActiveCell.Row, 1).EntireRow.Interior.ColorIndex = 0
wsCopyTo.Range("B" & currentNewSheetRow + 2).Value = wsCopyFrom.Range("B" & currentRow).Value
wsCopyTo.Range("C" & currentNewSheetRow + 2).Value = wsCopyFrom.Range("C" & currentRow).Value
wsCopyTo.Range("D" & currentNewSheetRow + 2).Value = wsCopyFrom.Range("D" & currentRow).Value
wsCopyTo.Range("G" & currentNewSheetRow + 2).Value = wsCopyFrom.Range("E" & currentRow).Value
wsCopyTo.Range("H" & currentNewSheetRow + 2).Value = wsCopyFrom.Range("F" & currentRow).Value
currentNewSheetRow = currentNewSheetRow + 1
Next i
Next currentRow
End Sub
Bookmarks