How to loop a a macro in excel VBA

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