Excel VBA每隔选择一个单元格并将其粘贴到另一张图纸中？

我需要将第8行的数据复制到另一张表（第2张）。我只需要复制每一个其他单元格，它应该复制单元格C8（值为的第一个单元格）、E8、G8、I8等等，从所有单元格一直复制到单元格IK8

有没有办法做到这一点？我在for循环中尝试了step函数，但它不起作用，只选择了一个单元格。它只为单元格H2:H130粘贴了一个值

Sub Workplace()

Dim rng As Range
Dim LastRow As Long
Dim I As Long

LastRow = Worksheets("Questions").Range("C" & Rows.Count).End(xlUp).Row
For I = 8 To LastRow Step 3
Set rng = Worksheets("Questions").Range("C" & I)
rng.Copy
Next I
Worksheets("Sheet1").Range("H2:H130").PasteSpecial Transpose:=True
End Sub

---

您需要增加列，而不是行

并在循环内移动粘贴，尽管需要增加目标单元格

For i = 3 to 245 Step 2 ' column C to column IK
    Set rng = Worksheets("Questions").Cells(8, i)

    With Worksheets("Sheet1")
        Dim dest as Range
        Set dest = .Range("H" & .Rows.Count).End(xlUp).Offset(1)
    End With

    rng.copy Destination:=dest
Next

或者更好，只需使用

Union

建立要复制的范围，然后一步复制：

For i = 3 to 245 Step 2 ' column C to column IK
    If rng Is Nothing Then
        Set rng = Worksheets("Questions").Cells(8, i)
    Else
        Set rng = Union(rng, Worksheets("Questions").Cells(8, i))
    End If
Next

rng.Copy
Worksheets("Sheet1").Range("H2").PasteSpecial Transpose:=True

Application.CutCopyMode = False

编辑：

“是否有办法将其粘贴到第1页H行的第一个空单元格中，而不是给它一个范围？”

是的，像下面这样：

Worksheets("Sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Transpose:=True

---

您需要增加列，而不是行

并在循环内移动粘贴，尽管需要增加目标单元格

For i = 3 to 245 Step 2 ' column C to column IK
    Set rng = Worksheets("Questions").Cells(8, i)

    With Worksheets("Sheet1")
        Dim dest as Range
        Set dest = .Range("H" & .Rows.Count).End(xlUp).Offset(1)
    End With

    rng.copy Destination:=dest
Next

或者更好，只需使用

Union

建立要复制的范围，然后一步复制：

For i = 3 to 245 Step 2 ' column C to column IK
    If rng Is Nothing Then
        Set rng = Worksheets("Questions").Cells(8, i)
    Else
        Set rng = Union(rng, Worksheets("Questions").Cells(8, i))
    End If
Next

rng.Copy
Worksheets("Sheet1").Range("H2").PasteSpecial Transpose:=True

Application.CutCopyMode = False

编辑：

“是否有办法将其粘贴到第1页H行的第一个空单元格中，而不是给它一个范围？”

是的，像下面这样：

Worksheets("Sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Transpose:=True

---

不必在循环中一次复制一个单元格，用户还可以将循环中的这些单元格合并为

，如果rng不存在，则设置rng=cell，否则设置rng=union（rng，cell）End If

，然后将其一次粘贴到Sheet1！H2Hello，有没有办法将其粘贴到第1页H行的第一个空单元格中，而不是给它一个范围？用户也可以在循环中一次复制一个单元格，而不是将这些单元格合并为

如果rng为空，则设置rng=cell，否则设置rng=union（rng，cell）如果

结束，则立即将其全部粘贴到Sheet1！H2Hello，有没有办法将其粘贴到第1页H行的第一个空单元格中，而不是给出一个范围？