在excel中使用VBA转换循环中的单元格

我试图从一张纸上复制单元格（成行），然后将它们粘贴到另一张纸上（基本上是转置）。我编写了代码，但无法绕过粘贴单元格和粘贴特殊命令。复制的单元格长度因每行而异，因此如何使其以相同的方式动态选择和粘贴？现在我想粘贴一个特定的长度，并在末尾删除空白行。请参阅下面的代码。如果有人能给我一个建议或想法，那就太棒了。谢谢

Sub Data_Sort_Test()

Dim i As Long, j As Long, k As Long, lastrow1 As Long, lastrow2 As Long
Dim rng As Range, row As Range, rowd1 As Range, cell As Range
Dim bidtype As String
k = 1
lastrow1 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).row

For i = 1 To lastrow1
bidtype = Sheets("Sheet2").Cells(i, "A").Value 

Sheets("Sheet1").Activate
lastrow2 = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).row

For j = 1 To lastrow2
If Sheets("Sheet1").Cells(j, "B").Value = bidtype Then

Sheets("Sheet2").Activate
Sheets("Sheet2").Range(Cells(i, "B"), Cells(i, "K")).Copy
Sheets("Sheet3").Activate
Sheets("Sheet3").Range(Cells(j, "C"), Cells(j, "L")).Select
ActiveSheet.Paste 'Special Transpose:=True
'k = k + 1
End If
Next j
Application.CutCopyMode = False
Next i

End Sub

---

试试这个，让我知道它是否有效：

Sub Data_Sort_Test()

Dim i As Long, j As Long, k As Long, lastrow1 As Long, lastrow2 As Long
Dim rng As Range, row As Range, rowd1 As Range, cell As Range
Dim bidtype As String
Dim tWs As Worksheet

Set tWs = Sheets("Sheet3")
With Sheets("Sheet2")
k = 1
lastrow1 = .Range("A" & .Rows.Count).End(xlUp).row

For i = 1 To lastrow1
    bidtype = .Cells(i, "A").Value

    lastrow2 = Sheets("Sheet1").Range("B" & Sheets("Sheet1").Rows.Count).End(xlUp).row
    For j = 1 To lastrow2
        If Sheets("Sheet1").Cells(j, "B").Value = bidtype Then

            .Range(.Cells(i, "B"), .Cells(i, "K")).Copy

            tWs.Range(tWs.Cells(j, "C"), tWs.Cells(j, "L")).PasteSpecial 'Transpose:=True

        End If
    Next j
    Application.CutCopyMode = False
Next i
End with
End Sub

---

我删除了所有的

。选择
和
。激活
，并直接用正确的亲子关系替换它们。这将加快代码的速度并使其更易于阅读。
@Scott我已经将转置放在了一起，但是rows.count有一个问题。你觉得怎么样

Sub Data_Sort_Test()

Dim i As Long, j As Long, k As Long, lastrow1 As Long, lastrow2 As Long
Dim rng As Range, row As Range, rowd1 As Range, cell As Range
Dim bidtype As String
Dim tWs As Worksheet

Set tWs = Sheets("Sheet3")
With Sheets("Sheet2")
k = 1
lastrow1 = .Range("A" & .Rows.Count).End(xlUp).row

For i = 1 To lastrow1
bidtype = .Cells(i, "A").Value

lastrow2 = Sheets("Sheet1").Range("B" & **strong text**Sheets("Sheet1").Rows.Count).End(xlUp).row
For j = 1 To lastrow2
    If Sheets("Sheet1").Cells(j, "B").Value = bidtype Then

        .Range(.Cells(i, "B"), .Cells(i, "K")).Copy

        tWs.Range("B" & Rows.Count).End(xlUp).Offset(0, 0).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        tWs.Range("B1").Delete shift:=xlUp

    End If
Next j
Application.CutCopyMode = False
Next i
End With
End Sub

“但无法绕过粘贴单元格和粘贴特殊命令”是什么意思？你有错误吗？如果有，是什么错误？它的行为是否与您预期的不一样？如果是这样，会发生什么？如果您尝试转置，从水平翻转到垂直，为什么要尝试将水平范围粘贴到水平范围？@chilli的意思是我无法编写转置它的代码。我得到一个1004运行时错误。@ScottCraner我的目的是翻转它。但我现在只是水平粘贴。我会换的。你有什么想法吗。我的意思是，在下一次迭代中，该范围内的单元格会从先前复制的单元格中得到更新，那么范围是多少？我如何共享我的数据集，以便它能给你们一个想法？你们可以链接到任何图像站点上的图片。我正在处理它并能够翻转它，但我对rows.count命令有问题。请看一看。我也相信你不能只粘贴值和转置在同一时间。它不是那样工作的。转置为all或nothing。@ScottCraner正确编译时没有任何错误，但粘贴时，当循环以row开头时，单元格（row.count）的长度不正确。进入循环前的row.count与内部的不同。