Home VBA code to repeat the same value 33 times, then go to the next value and repeat again

Questions

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

September 19, 2022

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!

>Solution :

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.