Question

如何用vba代码实现？将工作表1A列名单按工作表2的格式复制。谢谢！

Answer 1

按Alt+F11打开VBA编辑器，在左侧插入模块，双击模块，在右侧粘贴代码。

代码如下：

---

Sub 数据转换()

    Dim i&, irow&

    For i = 2 To 10 Step 3 '遍历2至10行，步长3

        irow = Range("E" & Rows.Count).End(3).Row + 1 '赋值irow等于E列的上界行号+1

        If Range("E1") = "" Then irow = 1 '如果E1是空的，那么重新赋值irow等于1

        Range("A1").Resize(1, 3).Copy '复制标题区

        Range("E" & irow).PasteSpecial Paste:=xlPasteAll, Transpose:=True '转置粘贴到E列

        Range("A" & i).Resize(3, 3).Copy '复制数据区

        Range("F" & irow).PasteSpecial Paste:=xlPasteAll, Transpose:=True '转置粘贴到F列

    Next

End Sub

---

如图，粘贴到Sheet2表，注意我画出来的四个地方，添加上Sheet2.即可。

代码如下：

Sub 数据转换()

    Dim i&, irow&

    For i = 2 To 10 Step 3 '遍历2至10行，步长3

        irow = Sheet2.Range("E" & Rows.Count).End(3).Row + 1 '赋值irow等于Sheet2表E列的上界行号+1

        If Sheet2.Range("E1") = "" Then irow = 1 '如果Sheet2表E1是空的，那么重新赋值irow等于1

        Range("A1").Resize(1, 3).Copy '复制标题区

        Sheet2.Range("E" & irow).PasteSpecial Paste:=xlPasteAll, Transpose:=True '转置粘贴到Sheet2表的E列

        Range("A" & i).Resize(3, 3).Copy '复制数据区

        Sheet2.Range("F" & irow).PasteSpecial Paste:=xlPasteAll, Transpose:=True '转置粘贴到Sheet2表的F列

    Next

End Sub

追问

转置到另一工作表呢？

追答

已经给你更新了答案。