我的代码适用于粘贴而不是粘贴特殊移调

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

该代码到目前为止运行良好，但它将数据粘贴到单个列中 – 它粘贴closures的工作簿1中的数据，然后find下一个空行并将数据从其下面的closures的工作簿2中粘贴，等等。 我需要它在粘贴时“转置”数据，所以数据会穿过这一行。

我已经成功地得到了粘贴特殊转置代码在另一个工作簿上自己的工作，但是当我尝试将其插入到我的代码中，要replace现有的粘贴线，我得到运行时错误1004'PasteSpecial方法的范围类失败'

有人可以帮忙吗？

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

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 

Answer 1

您正在closures工作簿，这样做会失去粘贴特殊function的能力。

尝试将工作簿分配给variables，然后在粘贴范围后使用该variablesclosures工作簿。

 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