Excel 尝试从多个工作表中复制某个范围，并以转置方式粘贴到一个工作表中，每列在一行中

尝试从所有工作表复制相同范围，并将转置粘贴到一个工作表中。 我想为目标工作表中的每一列获取一行。 到目前为止，我所尝试的是：

Sub contracts()
Dim sh As Worksheet
Dim wb As Workbook
Dim DestSh As Worksheet
Dim DestShLastRow As Long
Dim i As Integer
Application.ScreenUpdating = False
    Set wb = ActiveWorkbook
    Set DestSh = wb.Sheets("Total table")
    DestShLastRow = DestSh.Cells(DestSh.Rows.Count, "A").End(xlUp).Offset(1).Row
    i = 1
    For Each sh In ActiveWorkbook.Worksheets
    If sh.Name = "Total table" Then Exit Sub
        sh.Range("h3:h14").Copy
        DestSh.Range ("a" & i)
        .PasteSpecial xlPasteValues
        .PasteSpecial Transpose = True
        Application.CutCopyMode = False
        End With
    i = i + 1
    Next
Application.ScreenUpdating = True 
End Sub

当我运行这个代码时，我得到一个

1004错误，表示“范围类的特殊方法失败”

---

任何人对如何解决此问题有任何建议吗？

尝试在迭代部分以以下方式更改代码：

Dim arr As Variant
For Each sh In ActiveWorkbook.Worksheets
    If sh.Name = "Total table" Then Exit For
    arr = sh.Range("h3:h14").Value
    DestSh.Range("a" & i).Resize(, UBound(arr, 1)).Value = _
                             WorksheetFunction.Transpose(arr)
    i = i + 1
 Next

---

在迭代部分，尝试以以下方式更改代码：

Dim arr As Variant
For Each sh In ActiveWorkbook.Worksheets
    If sh.Name = "Total table" Then Exit For
    arr = sh.Range("h3:h14").Value
    DestSh.Range("a" & i).Resize(, UBound(arr, 1)).Value = _
                             WorksheetFunction.Transpose(arr)
    i = i + 1
 Next

---

我想您忘记了代码片段中带有的

（这里可能只是一个输入错误）。没错，只是一个输入错误。如果sh.Name=“Total table”，我将替换
，然后使用
如果sh.Name=“Total table”，退出Sub
“然后退出
。。。如果讨论中的工作表不是最后一个工作表，则到达时代码停止。我还将删除行
.PasteSpecial Transpose=True
，并将
Transpose
移到上面，结果是：
.PasteSpecial xlPasteValues，Transpose=True
。当然，在
DestSh.Range（“a”&i）
前面添加
With
之后，您还可以避免使用剪贴板托架，在声明区域使用数组：
Dim arr As Variant
，然后是
arr=sh.Range（“h3:h14”）。Value
后跟
。Resize（ubound（arr，2），1）。Value=WorksheetFunction.Transpose（arr）
中的
与。。。以
区域结束。我想你忘记了代码片段中的

和（这里可能只是一个输入错误）。没错，只是一个输入错误。如果sh.Name=“Total table”，我会替换

，然后退出Sub

，如果sh.Name=“Total table”，然后退出。。。如果讨论中的工作表不是最后一个工作表，则到达时代码停止。我还将删除行

.PasteSpecial Transpose=True

，并将

Transpose

移到上面，结果是：

.PasteSpecial xlPasteValues，Transpose=True

。当然，在

DestSh.Range（“a”&i）

前面添加

With

之后，您还可以避免使用剪贴板托架，在声明区域使用数组：

Dim arr As Variant

，然后是

arr=sh.Range（“h3:h14”）。Value

后跟

。Resize（ubound（arr，2），1）。Value=WorksheetFunction.Transpose（arr）

中的

与。。。以

区域结束。