Excel宏运行时间1004文件可能是只读的

Question

我试图从其他工作簿中提取数据到主工作簿中。所有这些工作簿都保存在一个文件夹中。此外，在提取数据之前，它会检查文件夹中的文件数量。如果只有一个文件并且它是主工作簿，那么它将停止并退出子文件。

但是，当我运行宏时，它陷入了“Do while”循环中。然后它说它有一个运行时错误1004，文档可能是只读或加密1。

我相信路径是正确的。

以下是我的代码。

Sub LoopThroughDirectory() 
    Dim MyFile As String 
    Dim erow 
    Dim Filepath As String 
    Filepath = "C:\Users\uidq3022\Desktop\Backup_Version2.0_7_12\" 
    MyFile = Dir(Filepath) 

    Do While Len(MyFile) > 0 
    If MyFile = "Import Info.xlsm" Then 
     Exit Sub 
    End If 

    Workbooks.Open (Filepath & MyFile) 
    Range("F9,F12,F15,F19,F21").Select 
    Range("F21").Activate 

    ActiveWindow.SmallScroll Down:=9 
    Range("F9,F12,F15,F19,F21,F27,F30,F33,F37").Select 
    Range("F37").Activate 

    ActiveWindow.SmallScroll Down:=9 
    Range("F9,F12,F15,F19,F21,F27,F30,F33,F37,F41").Select 
    Range("F41").Activate 

    ActiveWindow.SmallScroll Down:=-27 
    Range("F9,F12,F15,F19,F21,F27,F30,F33,F37,F41,F6").Select 
    Range("F6").Activate 
    Selection.Copy 
    ActiveWorkbook.Close 

    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
    ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 11)) 
    MyFile = Dir 
    Loop 
End Sub 

而且我的问题是，

1. 我不知道我在哪里出了毛病，“请勿而”循环
2. 如何修复运行时错误1004。

有人可以给我建议吗？非常感谢！

Answer 1

对我来说，你使用循环来打开文件，而不是自己手动进行。不知道为什么环路卡住，除非在运行时有MyFile = Dir行缺失或注释掉。

@Thomas大部分是正确的，1004错误发生是因为源工作簿太早关闭。但是，我可以使用wkbTarget.worksheets(1).paste粘贴这些值，但它将F6到F41之间的所有单元格粘贴 - 不是您想要的。

此外，您的复制范围是11行1列，但您指定的目标范围是1行11列：Cells(erow, 1), Cells(erow, 11)。如果这就是你真正想要的，你应该use Transpose。在Range()里面使用Cells(#,#)也产生了1004个错误，但是Cells(#,#).address解决了它。

这是我的看法：

Sub LoopThroughDirectory() 
    Dim MyFile As String 
    Dim wkbSource as Workbook 
    Dim wkbTarget as Workbook 
    Dim erow as single 
    Dim Filepath As String 

    Filepath = "C:\Users\uidq3022\Desktop\Backup_Version2.0_7_12\" 
    MyFile = Dir(Filepath) 

    Set wkbTarget = Workbooks(MyFile)     'Assuming the file is already open 

    Do While Len(MyFile) > 0 
    If MyFile = "Import Info.xlsm" Then Goto NextFile 'Skip the file instead of exit the Sub 

    Set wkbSource = Workbooks.Open (Filepath & MyFile) 'Set a reference to the file being opened 
    wkbSource.worksheet(1).Range("F9,F12,F15,F19,F21,F27,F30,F33,F37,F41,F6").Select 
    Selection.Copy 

    erow = wkbTarget.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
    wkbTarget.Worksheets("Sheet1").Paste Destination:=wkbTarget.Worksheets("Sheet1").Range(Cells(erow, 1).address) 

    wkbSource.Close 

NextFile: 
    MyFile = Dir 

    Loop 
    End Sub 

托马斯的单行复制粘贴+技术是很好的简洁。你可以重新排列代码行来使用这种方法，我只是建议清除Source和Target对象。