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

Question

Я хочу скопировать серые ячейки в строки, но скопирована только серая ячейка последнего столбца.

Answer 1

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

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

Answer 2

Существует альтернатива циклам.

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

Answer 3

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

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