Repeat the same value 33 times, then go to the next value and repeat again

Question

I have a set of individual data in Sheet1 Column "A"

I'd like every single value to repeat "y" times (currently y=33) in Sheet2 Column "A" and then repeat the next value 33 times etc.

I wrote code that repeats the values 33 times, but is overwriting in A1:A33.

Sub vba1()
    Dim lrow As Integer
    Dim i As Integer
    Dim y As Integer
    lrow = Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    y = 1
    For i = 1 To lrow
        Sheets("sheet1").Activate
        Cells(i, 1).Select
        Selection.Copy
        For y = 1 To 33
            Sheets("sheet2").Activate
            Cells(y, 1).PasteSpecial Paste:=xlPasteValues
        Next y
    Next i
End Sub

I tried a different approach, to increment y. I got a lot of empty rows:

Sub vba2()
    Dim lrow As Integer
    Dim i As Integer
    Dim y As Integer
    lrow = Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    y = 1
    For i = 1 To lrow
        Sheets("sheet1").Activate
        Cells(i, 1).Select
        Selection.Copy
        For y = y To y + 33
            Sheets("sheet2").Activate
            Cells(y, 1).PasteSpecial Paste:=xlPasteValues
            y = y + 33
        Next y
    Next i
End Sub

Ike · Answer 1 · 2022-09-19T12:45:34.287

If you have Excel 365 you could do it with a formula:

=LET(data,A2:A5,cnt,COUNTA(data),
repeat,C2,
MAKEARRAY(repeat*cnt,1,LAMBDA(r,c,INDEX(data,ROUNDUP(r/repeat,0)))))

Repeat-value can be changed to any value you need - also 33 :-)

You can use this formula in VBA as well. If you don't want a formula but fix values - you just write the values back to the sheet.

Sub vba1()

Dim rgTarget As Range
Set rgTarget = ThisWorkbook.Worksheets("Sheet2").Range("A1")

With rgTarget
    .CurrentRegion.Columns(1).Clear 'just in case there are data
    
    .Formula2 = "=LET(data,Sheet1!A2:A5,cnt,COUNTA(data), " & vbLf & _
        "repeat,Sheet1!C2, " & vbLf & _
        "MAKEARRAY(repeat*cnt,1,LAMBDA(r,c,INDEX(data,ROUNDUP(r/repeat,0)))))"
    
    With .SpillingToRange
        .Value = .Value
    End With
End With

End Sub

Foxfire And Burns And Burns · Accepted Answer · 2022-09-19T12:21:58.477

You are overwriting same destiny range in Sheet2. Easy solution with just 1 edit to your code would be adding a variable to store last position writed in sheet2 and start from there:

Sub vba1()
Dim lrow As Integer
Dim i As Integer
Dim y As Integer
Dim j As Integer

lrow = Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
j = 1

For i = 1 To lrow
    Sheets("sheet1").Activate
    Cells(i, 1).Select
    Selection.Copy
        For y = j To (j + 32)
            Sheets("sheet2").Activate
            Cells(y, 1).PasteSpecial Paste:=xlPasteValues
        Next y
        j = y
Next i
End Sub

Anyways, a better approach awould be avoiding Select and Activate because it takes too much time if you have a lot of values. You can refer a cell on another sheet using their worksheetname first (and their workbook too). So a better good looking code would be something like this:

Sub test()
Dim lrow As Long
Dim i As Long
Dim j As Long

j = 1

With ThisWorkbook.Worksheets("Sheet1")
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
End With

For i = 1 To lrow Step 1
    ThisWorkbook.Worksheets("Sheet2").Range("A" & j & ":A" & (j + 32)).Value = ThisWorkbook.Worksheets("Sheet1").Range("A" & i).Value
    j = j + 33
Next i

End Sub

It does exactly the same but it takes less time.

How to avoid using Select in Excel VBA

@Karoly Please, check updated answer, I added an example code you might find useful. — Foxfire And Burns And Burns, Sep 19 '22 at 12:22

Repeat the same value 33 times, then go to the next value and repeat again

2 Answers2