Copy & paste block of text number of times equal to value in cell

[azoll]

I have a block of text ranging from B5 to H28 that needs to be copied and
pasted below each other. The number of times it needs to be copied is
specified by the user of the worksheet in cell G4. I can get the block to
copy and paste once, but I don't know how to link it to the value in G4.
Thanks in advance for any suggestions!

 

[ryguy7272]

There may be a couple of ways to do what you want (I hope this is what you
want):

#1)
Sub CopyVariableRows()
Dim i As Long
Dim j As Long
Dim LastRow As Long
Dim cell As Range
Dim numval As Long
Dim Z As Long
Dim ws As Worksheet
Z = 1

Set ws = Worksheets("Copy Variable Rows")
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In ws.Range("A1:A" & LastRow)
For i = 1 To Len(cell.Value)
numval = Mid(cell.Value, i, 1)
For j = 1 To numval
ws.Cells(Z, "B").Value = numval
Z = Z + 1
Next
Next
Next
End Sub

#2)
Sub CopyVariableRows2()
Dim X As Long
Dim Z As Long
Dim Index As Long
Dim LastRow As Long
Dim Total As Long
Dim Contents() As Long
With Worksheets("Copy Variable Rows")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Total = Application.WorksheetFunction.Sum(.Range("A1:A" & LastRow))
If Total > Rows.Count Then
MsgBox "Error - You will go past the end of the worksheet!"
Exit Sub
End If
ReDim Contents(1 To Total)
For X = 1 To LastRow
For Z = 1 To .Cells(X, "A").Value
Index = Index + 1
Contents(Index) = .Cells(X, "A").Value
Next
Next
For X = 1 To Total
..Cells(X, "A").Value = Contents(X)
Next
End With
End Sub


HTH,
Ryan---