0

I was attempting to extract data from other workbooks into a master workbook. All of these workbooks were saved in one folder. Besides, before extracting the data it would check the number of files in the folder. If there is only one file and it is the master workbook then it will stop and exit sub.

However, when I ran the macro it got stuck in the "Do while" loop. Then it says it has a run time error 1004, document may be read-only or encrypted1.

I am sure the path is correct.

Below is my code.

 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

And my questions are,

  1. I don't know where I went wrong with the "Do while" loop
  2. How to fix the run time 1004 error.

Can someone give me advise? Thanks a lot!

Dirk Reichel
  • 7,989
  • 1
  • 15
  • 31
hzxerh
  • 5
  • 3

1 Answers1

0

Seems to me you're using the loop to open the files instead of doing it manually yourself. Not sure why the loop got stuck unless you had the MyFile = Dir line missing or commented out at runtime.

@Thomas is mostly right, the 1004 error is happening because the source workbook is being closed too early. However, I was able to paste the values using wkbTarget.worksheets(1).paste but it pasted all cells between F6 through F41 - not what you want.

Additionally, your copy range is 11 rows, 1 column but you're specifying a destination range of 1 row, 11 columns: Cells(erow, 1), Cells(erow, 11) . If that's what you really want, you should use Transpose. Using Cells(#,#) inside Range() also produced 1004 errors, but Cells(#,#).address resolved it.

Here's my take:

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

Thomas's single-line copy+paste technique is nicely concise. You could rearrange the lines of code to use that approach, I just recommend making the Source and Target objects clear.

Community
  • 1
  • 1
MJA
  • 350
  • 1
  • 3
  • 15
  • I don't know how I missed that. Thanks –  Jul 15 '16 at 04:14
  • @ThomasInzina, it happens to me too. I didn't want to plagiarize your elegant one-line copy+paste. Would you be willing to put that up again? – MJA Jul 15 '16 at 04:23
  • There is no need to re-post it. Your solution is the correct one. '`wkbTarget.Worksheets("Sheet1").Paste' This should be Copy not Paste. –  Jul 15 '16 at 04:29
  • Thank you so much! I didn't notice that cells issue – hzxerh Jul 15 '16 at 14:42