Insert Rows as many as a Cell's Value

Option Explicit


Sub Munayus()
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("Sheet1"): Set s2 = Sheets("Sheet2")
    Dim i As Long, lr As Long
    Dim lr2 As Long, x As Long
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To lr
        x = Range("B" & i)
        lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row + 1
        s1.Range("A" & i).Copy
        s2.Range("A" & lr2 & ":A" & lr2 + x - 1).PasteSpecial xlPasteValues
    Next i
    Application.CutCopyMode = False
End Sub

Standard Module
How to install your new code
Copy the Excel VBA code
Select the workbook in which you want to store the Excel VBA code
Press Alt+F11 to open the Visual Basic Editor
Choose Insert > Module
Edit > Paste the macro into the module that appeared
Close the VBEditor
Save your workbook (Excel 2007+ select a macro-enabled file format, like *.xlsm)

To run the Excel VBA code:
Press Alt-F8 to open the macro list
Select a macro in the list
Click the Run button

CROSS POST

This question has been posted in at least one other forum.

Do not post any further responses in this thread until a link has been provided to these cross posts.

Whilst we would rather you didn't cross-post, we know that there may be a valid reason for doing so. All we ask is that you provide the links in your original post to your question in the other forum(s). Read this to understand why.

This forum is full of volunteers that give up their own time to help others, something that should be respected and not taken for granted. It’s never nice for someone to find out that a problem they have spent time solving for you has already been answered somewhere else without them knowing, and so we ask you to make it clear that you have also asked elsewhere.

Please provide the link(s). If you are unable to do so, tell us where else you have posted this query.