Excel VBA - Repeat data x times and changing value in a column

Question

I am attempting to create a macro where I can repeat a range of data 4 times, but changing the value in one column in each instance of repetition. Example-

Current Data:

Col A   | Col B   | Col C  |    
------  | ------  | ------ |    
data a1 |constant | data c1|    
data a2 |constant | data c2|

Expected Data:

Col A   | Col B   | Col C  |    
------  | ------  | ------ |    
data a1 |constant | data c1|    
data a2 |constant | data c2|    
data a1 |constantx| data c1|    
data a2 |constantx| data c2|    
data a1 |constanty| data c1|    
data a2 |constanty| data c2|    
data a1 |constantz| data c1|    
data a2 |constantz| data c2|

I have to do this for multiple files and the data is present in more than 1 row.Each file will have different number of rows that will contain data to copy.

I am able to repeat the data using the below code(for any umber of rows), but I am not able to change the values in middle column. Any help would be greatly appreciated.

Sub Macro1()
Dim lRow As Long
Range("A1").Select
lRow = Cells(Rows.Count, 1).End(xlUp).Row
    If lRow = 2 Then
        Range("A2").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        Range("A" & Rows.Count).End(xlUp).Offset(1).Select
        ActiveSheet.Paste
        Range("A" & Rows.Count).End(xlUp).Offset(1).Select
        ActiveSheet.Paste
        Range("A" & Rows.Count).End(xlUp).Offset(1).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
    Else
        Range("A2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        Range("A" & Rows.Count).End(xlUp).Offset(1).Select
        ActiveSheet.Paste
        Range("A" & Rows.Count).End(xlUp).Offset(1).Select
        ActiveSheet.Paste
        Range("A" & Rows.Count).End(xlUp).Offset(1).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
    End If

End Sub

Answer 1

You can put your input in below ways

1. Please enter the number of time , the data you want repeat. e.g 2
   or 3

if your input is like below

Col A   Col B   Col C
data a1 Constant    data c1
data a2 Constant    data c2

and number of time reapat data = 3

then your output will be

Col A   Col B   Col C
data a1 Constant    data c1
data a2 Constant    data c2
data a1 Constant1   data c1
data a2 Constant2   data c2
data a1 Constant1   data c1
data a2 Constant2   data c2
data a1 Constant1   data c1
data a2 Constant2   data c2

Case 2 :

if your input is like below

Col A   Col B   Col C
data a1 Constant    data c1
data a2 Constant    data c2
data a3 Constant    data c3


number of time reapat data  = 4


then your output will be

Col A   Col B   Col C
data a1 Constant    data c1
data a2 Constant    data c2
data a3 Constant    data c3
data a1 Constant1   data c1
data a2 Constant2   data c2
data a3 Constant3   data c3
data a1 Constant1   data c1
data a2 Constant2   data c2
data a3 Constant3   data c3
data a1 Constant1   data c1
data a2 Constant2   data c2
data a3 Constant3   data c3
data a1 Constant1   data c1
data a2 Constant2   data c2
data a3 Constant3   data c3

code will be

Sub Demo()

Dim Start_Row As Integer
Dim No_Of_Tm_Reapts As Integer
Dim Temp As Integer

Dim ColA_arra() As Variant
Dim ColB_arra() As Variant
Dim ColC_arra() As Variant

Dim i As Integer
Dim j As Integer

Dim cnt As Integer

Start_Row = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1

Temp = Start_Row

No_Of_Tm_Reapts = InputBox(prompt:="Enter the limit", Title:="Temp", Default:="")

'Filling 1st column Array

ReDim ColA_arra(0 To Start_Row)
ReDim ColB_arra(0 To Start_Row)
ReDim ColC_arra(0 To Start_Row)

Range("B2:B" & Start_Row - 1).Value = "Constant"

cnt = 0
For i = 0 To Start_Row - 3

    ColA_arra(i) = ActiveSheet.Cells(i + 2, 1).Value
    ColB_arra(i) = ActiveSheet.Cells(i + 2, 2).Value
    ColC_arra(i) = ActiveSheet.Cells(i + 2, 3).Value

    cnt = cnt + 1

Next i

' filling 1st column

For i = 1 To No_Of_Tm_Reapts

  For j = 1 To cnt

    ActiveSheet.Cells(Start_Row, 1).Value = ColA_arra(j - 1)
    ActiveSheet.Cells(Start_Row, 3).Value = ColC_arra(j - 1)

    Start_Row = Start_Row + 1

Next j

Next i

For i = Temp To Start_Row - 1

 Start_Const = 1
 For j = 1 To cnt

    ActiveSheet.Cells(Temp, 2).Value = "Constant" & Start_Const
    Start_Const = Start_Const + 1
    Temp = Temp + 1

 Next j

If Temp >= Start_Row - 1 Then
    Exit For
End If

Next i

End Sub

Answer 2

A bit easier with Excel Formulas if you want to copy just the values without the formatting:

Sub Macro1()
    [a3:c8] = "=a1"
    [b3:b8] = "=b$1 & Int(Row(2:2)/2)"
    [a3:c8] = [a3:c8].Value2             ' optional to convert the formulas to values
End Sub