从1个工作簿复制和转置值到另一个

Sub LoopThroughDecTab() Dim MyFile As String Dim erow Dim FilePath As String FilePath = "C:" MyFile = Dir(FilePath) Do While Len(MyFile) > 0 If MyFile = "Dec Tab Macro.xlsm" Then Exit Sub End If Workbooks.Open (FilePath & MyFile) ActiveWorkbook.Worksheets("Declaration Analysis (Source)").Activate Range("H9:H21").Copy ActiveWorkbook.Close False 

“运行时错误PasteSpecialMethod的范围失败,在下一行”

 ActiveSheet.Range(Cells(erow, 1), Cells(erow, 7)).PasteSpecial.Range Transpose:=True MyFile = Dir Loop End Sub 

我有一个文件夹中的文件,代码循环通过文件副本值,然后我想这些值转置到活动MasterSheet。 有7个值需要粘贴,然后打开文件夹中的下一个工作簿并重复该过程。

假设你发布了完整的代码,只是插入了“非代码”的消息告诉我们你的错误在哪里,请尝试一下:

 Option Explicit Sub LoopThroughDecTab() Dim MyFile As String Dim erow Dim FilePath As String Dim DestWB as Workbook Dim SourceWB as Workbook 'this way we know the one where the code is running and the destination for our copies set DestWB = ThisWorkbook FilePath = "C:" MyFile = Dir(FilePath) Do While Len(MyFile) > 0 If MyFile = "Dec Tab Macro.xlsm" Then Exit Sub End If Set SourceWB = Workbooks.Open (FilePath & MyFile) SourceWB.Worksheets("Declaration Analysis (Source)").Range("H9:H21").Copy 'Move the close to AFTER you do the paste 'NOTE: You may have to make a change here: DestWB.Range(Cells(erow, 1), Cells(erow, 7)).PasteSpecial.Range Transpose:=True SourceWB.Close False MyFile = Dir Loop End Sub 

如果您在Excel中打开两个工作簿(A和B),从A复制一些单元格,closuresA,然后尝试粘贴到B中,您将无法粘贴 – closuresA清除剪贴板缓冲区。 我相信同样的事情发生在这里。

重要笔记:

  1. 我已经删除了所有对ActiveWorkbook引用 – 我相信我已经得到它的正确性,但是使用Active*时总会有点失落,所以我不惜一切代价避免它。 (有很less的情况下,这是唯一的方法来完成的事情,这不是其中之一。)如果我已经搞乱你的来源和复制的目的地,只要扭转Set语句,所以你使用他们的另一种方式。
  2. 我不确定erowFilePath在哪里设置,所以我假设这不是完整的代码。 假设是,他们仍然会设置。
  3. 我没有使用复制/转置function,因此您可能也需要包含Excel开发人员的调整。

没有看到你正在复制什么是很难理解的问题,但你可以尝试:

 ActiveSheet.Cells(erow, 1).PasteSpecial Transpose:=True 
 set CopyFromRange = Range("H9:H21") set CopyToRange = ActiveSheet.Cells(erow,1).Resize(1,13) CopyToRange.Value = Application.Transpose(CopyFromRange.Value)