# Copy values in Column A and insert 8 times

#### riteon

##### New Member
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.

Code:
``````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

### Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

#### My Aswer Is This

##### Well-known Member
Try this:
Code:
``````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

##### New Member
Perfect! Thanks so much! R

Replies
0
Views
352
Replies
4
Views
163
Replies
14
Views
202
Replies
16
Views
307
Replies
2
Views
134

1,195,702
Messages
6,011,200
Members
441,594
Latest member
AVO

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back