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

I'm pretty new to VBA codes and I've run to the following issue:

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've wrote a code but what's happening its repeating the values 33 times, but only overwriting itself in A1:A33 and I cant figure it out why.

My current code looks as follows:

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've tried with a different approach, to somehow make y to increment but what I've got with this method I have 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

I'd really appreciate any help! Thank you!

CodePudding user response：

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

CodePudding user response：

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