Для следующего цикла (новичок)

Вы так близко :)

Option Explicit

Sub istebu()

Dim x As Long
Dim i As Long

For i = 3 To 10 'Loop in row from 3 to 10
    For x = 3 To 21 Step 3 'Loop header row, from 3 to 21, jump 3
        Cells(i, 1) = Cells(1, x) 'Copy values.
        i = i + 1 'Add one row each time, so we don't overwrite previously row
    Next x
Next i
End Sub

Альтернатива:

Его можно сократить, так как нам не нужно перебирать строки. Нам нужно только добавить их. Итак, мы устанавливаем i в начальную строку, куда мы должны вставить наши данные.

Sub istebu()

Dim x As Long
Dim i As Long

i = 3 'Set first row number you want to loop from.

For x = 3 To 21 Step 3 'Loop header row, from 3 to 21, jump 3
        Cells(i, 1) = Cells(1, x) 'Copy values.
        i = i + 1 'Add one row each time, so we don't overwrite previously row
Next x
End Sub

Нет необходимости во вложенных циклах

Sub Test()
Dim r As Integer, c As Integer

r = 3
For c = 3 To 21 Step 3
    Cells(r, 1) = Cells(1, c)
    r = r + 1
Next c
End Sub

Есть вообще альтернатива петлям.

Range("C1,F1,I1,L1,O1,R1,U1").Copy
Range("A3").PasteSpecial Paste:=xlPasteValues, Transpose:=True

Но если вам действительно нравятся петли, используйте их для создания союза.

dim i as long, rng as range

for 3 to 21 step 3
    if rng is nothing then
        set rng = cells(1, i)
    else
        set rng = union(rng, cells(1, i))
    end if
next i

rng.Copy
Range("A3").PasteSpecial Paste:=xlPasteValues, Transpose:=True