How to loop a a macro in excel VBA

Question

I want to loop a certain macro in excel VBA. However, I don't know how to do this (I tried and failed multiple times). The annotations in the code below are given to show what I want to do. The code as it is works perfectly, I just want it to loop for every chunck of data until all data has been transposed into the second worksheet (the first worksheet contains about 5000 rows of data, and every 18 rows has to be transposed into 1 row in the second worksheet):

    Sub test()

' test Macro

Range("G2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-1]*100"
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G19"), Type:=xlFillDefault
Range("G2:G19").Select
Range("A2:C2").Select
Selection.Copy
Sheets("Sheet2_Transposed data").Select
Range("A2").Select
ActiveSheet.Paste
    'I want to loop this for every next row until all data has been pasted (so A3, A4, etc.)
Sheets("Sheet1_session_data").Select
Range("G2:G19").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2_Transposed_data").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True
Range("D2:U2").Select
Application.CutCopyMode = False
    'Here I also want to loop for every next row until all data has been transposed and pasted (e.g. D3:U3, D4:U4 etc.)
Selection.NumberFormat = "0"
Sheets("Sheet1_session_data").Select
Rows("2:19").Select
Selection.Delete Shift:=xlUp
    ' Here I delete the entire data chunck that has been transposed, so the next chunck of data is the same selection. 

End Sub

Hope this question was understandable, and I hope someone can help. Thanks.

Answer 1

You can actually reduce your code.

First Tip:

Please avoid the use of .Select/.Activate INTERESTING READ

Second Tip:

Instead of doing an Autofill, you can enter the formula in the relevant cells in one go. For example. this

Range("G2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-1]*100"
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G19"), Type:=xlFillDefault

can be written as

Range("G2:G19").FormulaR1C1 = "=RC[-2]/RC[-1]*100"

Third Tip:

You don't need to do a copy and paste in separate lines. You can do it in one line. For example

Range("A2:C2").Select
Selection.Copy
Sheets("Sheet2_Transposed data").Select
Range("A2").Select
ActiveSheet.Paste

can be written as

Range("A2:C2").Copy Sheets("Sheet2_Transposed data").Range("A2")

Same thing when you are doing a PasteSpecial. But you use .Value = .Value soo this

Range("G2:G19").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1_Transposed_data").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

can be written as

Sheets("Sheet1_Transposed_data").Range("D2:D19").Value = _
Sheets("Sheet1").Range("G2:G19").Value

Missed the Transpose part. (Thanks Simoco). In this case, you can write the code as

Range("A2:C2").Copy 
Sheets("Sheet2_Transposed data").Range("D2").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Fourth Tip:

To loop through cells, you can use a For Loop. Say you want to loop though cells A2 to A20 then you can do like this

For i = 2 To 20
    With Range("A" & i)
        '
        '~~> Do Something
        '
    End With
Next i

EDIT:

Your before and after Screenshots (From Comments):

and

After seeing your screenshots, I guess this is what you are trying? This is untested as I just quickly wrote it. Let me know if you get any errors :)

Sub test()
    Dim wsInPut As Worksheet, wsOutput As Worksheet
    Dim lRow As Long, NewRw As Long, i As Long

    '~~> Set your sheets here
    Set wsInPut = ThisWorkbook.Sheets("Sheet1_session_data")
    Set wsOutput = ThisWorkbook.Sheets("Sheet2_Transposed data")

    '~~> Start row in "Sheet2_Transposed data"
    NewRw = 2

    With wsInPut
        '~~> Find Last Row
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        '~~> Calculate the average in one go
        .Range("G2:G" & lRow).FormulaR1C1 = "=RC[-2]/RC[-1]*100"

        '~~> Loop through the rows
        For i = 2 To lRow Step 18
            wsOutput.Range("A" & NewRw).Value = .Range("A" & i).Value
            wsOutput.Range("B" & NewRw).Value = .Range("B" & i).Value
            wsOutput.Range("C" & NewRw).Value = .Range("C" & i).Value

            .Range("G" & i & ":G" & (i + 17)).Copy

            wsOutput.Range("D" & NewRw).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=True

            NewRw = NewRw + 1
        Next i

        wsOutput.Range("D2:U" & (NewRw - 1)).NumberFormat = "0"
    End With
End Sub