从一个工作簿拷贝和转置值到另一个工作簿

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

'Getting Runtime error PasteSpecialMethod of Range Failed on following line'

“获取运行时错误，特别是范围失败的方法”

ActiveSheet.Range(Cells(erow, 1), Cells(erow, 7)).PasteSpecial.Range Transpose:=True 

MyFile = Dir

Loop

End Sub

I have files in a folder, the code loops through the files copies values and then I want those values Transposed into the Active MasterSheet. There are 7 values that need to be pasted, and then it should open the next workbook in folder and repeat the process.

我在一个文件夹中有文件，代码循环遍历文件复制值，然后我希望这些值转置到活动母版中。有7个值需要粘贴，然后它应该打开文件夹中的下一个工作簿并重复这个过程。

3 个解决方案

#1

Assuming that you posted your complete code, and simply interjected the 'non-code' message to tell us where your error was, give this a try:

假设您发布了完整的代码，并简单地插入了“非代码”消息，告诉我们您的错误在哪里，请尝试一下:

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

If you open two workbooks (A & B) in Excel, copy some cells from A, close A, then try to paste into B, you'll have nothing left to paste - closing A clears the clipboard buffer. I believe the same thing is happening here.

如果在Excel中打开两个工作簿(A & B)，从A中复制一些单元格，关闭A，然后尝试粘贴到B中，那么就没有什么可粘贴的了——关闭A清除剪贴板缓冲区。我相信同样的事情正在这里发生。

Important Notes:

1. I've removed all references to ActiveWorkbook - I believe that I've gotten it correct, but I always get a bit lost when using Active*, so I avoid it at all cost. (There are a very few situations where it's the only way to get things done, this isn't one of them.) If I've messed up your source & destinations for the copy, simply reverse the Set statements so you're using them the other way.
2. 我已经删除了ActiveWorkbook的所有引用——我相信我已经纠正了它，但是在使用Active*时总是会丢失一些，所以我不惜一切代价避免它。(在少数情况下，这是完成任务的唯一方法，但这不是其中之一。)如果我把复制的源和目的地搞砸了，只要把Set语句颠倒一下就可以了。
3. I'm not sure where erow and FilePath are getting set, so I'm assuming this wasn't the complete code. The assumption is that they'll still get set somehow.
4. 我不确定erow和FilePath设置在哪里，所以我假设这不是完整的代码。假设它们仍然是固定的。
5. I've not used the copy/transpose function, so you may well need to include Excel Developers's adjustments, as well.
6. 我没有使用复制/转置函数，所以您可能也需要包含Excel开发人员的调整。

#2

It's difficult to understand what's the problem without seeing what are you copying, but you can try:

要想弄明白问题出在哪里，你很难不看到你在抄袭什么，但你可以试试:

ActiveSheet.Cells(erow, 1).PasteSpecial Transpose:=True 

#3

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