Question

所以我从输入表单中得到一组垂直数据，我们称之为调查。此调查询问姓名，电子邮件和年龄。调查在一个长列表中编译成Sheet2，假设100个响应，或300行。

我希望能够转移这些数据，因此需要将其放入顶部有NAME | EMAIL | AGE的水平表中，然后填写下面的响应，每次点击时都会开始一个新行名称，或每第4个细胞重复。

我有这个，它获取当前页面并转置它，但我需要能够运行此宏来从一个工作表复制并粘贴到另一个工作表。

如果有帮助，这是我的代码：

Public Sub TransposeData()
Dim LastRow As Long
Dim NextRow As Long
Dim i As Long

Application.ScreenUpdating = False
With Worksheets("Sheet1")

    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = 1 To LastRow Step 8

        .Cells(i, "A").Resize(8).Copy
        NextRow = NextRow + 1
        .Cells(NextRow, "B").PasteSpecial Paste:=xlPasteAll, Transpose:=True
    Next i

    .Rows(NextRow + 1).Resize(LastRow - NextRow).Delete
    .Columns(1).Delete
End With

Application.ScreenUpdating = True
End Sub

Answer 1

这样的事情：

Public Sub TransposeData()

    Const NUM As Long = 4
    Dim rngCopy As Range, rngPaste As Range

    Set rngCopy = Worksheets("Sheet1").Range("A1").Resize(NUM, 1)
    Set rngPaste = Worksheets("Sheet2").Range("A1")

    Do While Application.CountA(rngCopy) > 0

        rngCopy.Copy
        rngPaste.PasteSpecial Paste:=xlPasteAll, Transpose:=True

        Set rngCopy = rngCopy.Offset(NUM, 0)
        Set rngPaste = rngPaste.Offset(1, 0)

    Loop

End Sub

将垂直单元格复制并粘贴到末尾另一张纸上的水平行中

1 个答案: