如何将range中的每一行复制并转置粘贴到新工作表中？

Question

我有一个工作表，上面有不同的数据。我想将指定范围内的每一行复制、转置粘贴到每一行的单独工作表上。我几乎被困住了，因为我对此还很陌生。

我不太明白从哪里开始。

Sub LoopRow()

Dim rng As Range
Dim row As Range
Dim cell As Range

Set rng = Range("A6:AI57")

For Each row In rng.Rows


End Sub

Answer 1

使用以下代码：

您所需要做的就是更改工作表名称。我们循环遍历指定的范围，并使用转置将每行复制粘贴到另一个sheets列上。

Sub LoopRow()

Dim rng As Range
Dim row As Range
Dim cel As Range
Dim i As Integer

Set rng = Worksheets("Name of sheet where data is").Range("A6:AI57")

i = 1
For Each row In rng.Rows

    row.Copy
    Worksheets("Name where you want your data to go").Cells(1, i).PasteSpecial Transpose:=True
    i = i + 1

Next

End Sub

它将粘贴来自第一个单元格的数据。您可以通过将cells(2,i)更改为second等等来更改这一点。

Answer 2

尝试使用此宏

   Option Explicit
Sub TranPose_Range()
Dim rng As Range

'Source_sheet====>> name of sheet where the data is
'Target_sheet====>> name of sheet where you want your data to go
   Set rng = Sheets("Source_sheet").Range("A6").CurrentRegion
   rng.Copy
   Sheets("Target_sheet").Cells(1, 1).PasteSpecial , Transpose:=True

End Sub