Question

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

但是，当我运行宏时，它会卡在＆＃34; Do while＆＃34;环。然后它说它有一个运行时错误1004，文件可能是只读的或加密的。

我确信路径是正确的。

以下是我的代码。

 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

我的问题是，

我不知道我在哪里出错了＆＃34;做什么时候＆＃34;环
如何解决运行时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。在Cells(#,#)内使用Range()也会产生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对象清除。

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

1 个答案: