VBA copy contents of a row and multiply it based on a cell value

Question

I have the following code

Sub copy()

Dim rngSource As Range
Dim copyCount As Long

With Sheets("Sheet1").Range("H2")
    copyCount = .Value
    Set rngSource = .EntireRow.Range("C1:F1")
End With

With Sheets("Sheet2").Range("A2")
    .Resize(copyCount, rngSource.Columns.Count).Value = rngSource.Value
End With

End Sub

What it does: It copies the contents of the first row from C1 to F1 on sheet2 and multiplies the number of rows based on the value that H2 has. So if the cell H2 has the number 4, it takes all the cells from Sheet1 starting from C1 to F1 and makes 4 rows in Sheet2 with that. Now I want it to do the same thing for each row that Sheet1 has as at the moment it only does the operation for 1 row.

I think the For Each loop would be required but I have tried several times and it failed me.

Any help is well received. Thank you!

Answer 1

Try the next code, please. I hope I correctly understood your need. If not, please better describe it...

Sub copySpecial()
 Dim sh1 As Worksheet, sh2 As Worksheet, lastRow1 As Long, lastRow2 As Long, arrC As Variant
 Dim copyCount As Long, i As Long

 Set sh1 = Sheets("Sheet1"): Set sh2 = Sheets("Sheet2")

 lastRow1 = sh1.Range("C" & Rows.count).End(xlUp).row

 For i = 2 To lastRow1
   copyCount = sh1.Range("H" & i).Value
   arrC = sh1.Range("C" & i & ":F" & i)
   lastRow2 = sh2.Range("A" & Rows.count).End(xlUp).row + 1
   If lastRow2 < 14 Then lastRow2 = 14
   If copyCount > 0 Then
        sh2.Range("A" & lastRow2).Resize(copyCount, 4).Value = arrC
   End If
 Next i
End Sub