Copy values in Column A and insert 8 times

[riteon]

Dear All,

I'm aware of the VBA code below that allows you to copy Cell A1 x the amount of times indicated in Cell B1 etc, and this works perfectly, however I have to put 8 in every cell of column B. I really want to do this for a constant value, rather than a value taken from Column B.

Sub CopyData()
Dim lRow As Long
Dim RepeatFactor As Variant

    lRow = 1
    Do While (Cells(lRow, "A") <> "")
           
        RepeatFactor = Cells(lRow, "B")
        If ((RepeatFactor > 1) And IsNumeric(RepeatFactor)) Then
                   
           Range(Cells(lRow, "A"), Cells(lRow, "B")).Copy
           Range(Cells(lRow + 1, "A"), Cells(lRow + RepeatFactor - 1, "B")).Select
           Selection.Insert Shift:=xlDown
              
           lRow = lRow + RepeatFactor - 1
        End If
       
        lRow = lRow + 1
    Loop
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

Is there an easier way by simplifying the VBA formula (so it doesn't base on value of B, just a numerical value in the formula itself)?

Thanks in advance for any help

R

 

[My Aswer Is This]

Try this:

Sub CopyData()
Dim lRow As Long
Dim RepeatFactor As Variant
Dim Num As Integer
Num = InputBox("How Many Copies")
    lRow = 1
    Do While (Cells(lRow, "A") <> "")
           
        RepeatFactor = Num 'Cells(lRow, "B")
        If ((RepeatFactor > 1) And IsNumeric(RepeatFactor)) Then
                   
           Range(Cells(lRow, "A"), Cells(lRow, "B")).Copy
           Range(Cells(lRow + 1, "A"), Cells(lRow + RepeatFactor - 1, "B")).Select
           Selection.Insert Shift:=xlDown
              
           lRow = lRow + RepeatFactor - 1
        End If
       
        lRow = lRow + 1
    Loop
    Application.CutCopyMode = False
    Range("A1").Select
    
End Sub

 

[riteon]

Perfect! Thanks so much! R

 

[My Aswer Is This]

Glad I could Help.