我的代码适用于粘贴但不适用于粘贴特殊转置答案

【问题标题】：My code works with Paste but not Paste Special Transpose我的代码适用于粘贴但不适用于粘贴特殊转置
【发布时间】：2017-07-13 18:15:59
【问题描述】：

我有一些代码可以从多个已关闭的工作簿中复制一列数据并将其粘贴到单个主工作簿中。

到目前为止，该代码运行良好，但它将数据粘贴到单个列中 - 它粘贴了已关闭工作簿 1 中的数据，然后找到下一个空行并将已关闭工作簿 2 中的数据粘贴到其下方，依此类推。我需要它在粘贴时“转置”数据，以便数据跨行。

我已经成功地让 Paste Special Transpose 代码在另一个工作簿中独立工作，但是当我尝试将其插入到我的代码中以替换现有的 Paste 行时，我收到 Runtime error 1004 'PasteSpecial method of Range class失败'

有人可以帮忙吗？

这是我的代码，“特殊粘贴”部分前面带有 '

Sub LoopThroughDirectory()

 Dim MyFile As String

 Dim erow

 Dim Filepath As String

 Filepath = "Z:\Functional workstreams\Risk and compliance\Compliance steering group\Life & Limb\RETURNS - 2017\Test\"

MyFile = Dir(Filepath)
 Do While Len(MyFile) > 0

Workbooks.Open (Filepath & MyFile)
 Range("D3:D24").Copy

 Application.DisplayAlerts = False

 ActiveWorkbook.Close

 erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

 'ActiveSheet.Cells(erow, 1).Select

 'Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks:=False, Transpose:=True

ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 25))

MyFile = Dir
 Loop
 End Sub

【问题讨论】：

标签： vba excel

【解决方案1】：

您正在关闭工作簿，这样做会失去特殊粘贴功能。

尝试将工作簿分配给一个变量，然后在粘贴范围后使用该变量关闭工作簿。

Sub LoopThroughDirectory()
    Dim MyFile As String
    Dim erow
    Dim Filepath As String
    Dim wb As Workbook, src_wb As Workbook
    Dim ws As Worksheet

    Set wb = ThisWorkbook
    Set ws = wb.ActiveSheet
    Filepath = "Z:\Functional workstreams\Risk and compliance\Compliance steering group\Life & Limb\RETURNS - 2017\Test\"

    MyFile = Dir(Filepath)

    Do While Len(MyFile) > 0
        Set src_wb = Workbooks.Open(Filepath & MyFile)
        Range("D3:D24").Copy

        Application.DisplayAlerts = False

        erow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

        ws.Range("A" & erow).PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks:=False, Transpose:=True
        src_wb.Close False

        MyFile = Dir
    Loop
End Sub

【讨论】：