VBA Run time error

Mr2017

Well-known Member
Joined
Nov 28, 2016
Messages
644
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi

I'm trying to import 3 files from a folder called "ExcelFilesToImport" that sits within in the Documents path.

But I get a run time error that says "Sorry, we couldn't find Apples.xlsx. It is possible it was moved, renamed or deleted." (see first screenshot attached).

However, the file is definitely an xlsx file and hasn't been moved, renamed or deleted (see second screenshot attached). When you right-click on it and click on Properties, the type is "Microsoft Excel Worksheet (.xlsx)"

Does anyone know what needs to be corrected in the code at the bottom of this message, please?

The files I'm importing are simple:

File 1 is called Apples and has the text 'Apples' in B3 and the number 1 in B4.
File 2 is called Bananas and has the text 'Bananas' in B3, the number 2 in B4, and the number 3 in B5.
File 3 is called Pears and has the text 'Pears' in B3, the number 3 in B4, and the number 4 in B5 and the number 5 in B6.

I'd like to import all of them, so that the data from each file is pasted into one tab in the active file with the macro.

But I'd like to ensure there is a blank row between the data from each file.

Eg if data from File 1 populates cells B3 and B4 in the imported data tab, then data from File 2 would populate cells B5 (row 4 would be blank) and B6.


VBA Code:
Sub ImportInto1Tab()

  Dim FolderPath As String, Filename As String, Sheet As Worksheet, sh As Worksheet

  Dim lr As Long, lc As Long, lr1 As Long

 

  Application.ScreenUpdating = False

  Path = "C:\Users\" & Environ("UserName") & "\Documents\ExcelFilesToImport\"

  'FolderPath = Environ("userprofile") & "\Desktop\Test\"

  'Filename = Dir(FolderPath & "*.xls*")

  Filename = Dir(Path & "*.xls")

  Set sh = Sheets.Add(before:=Sheets(1))

 

  Do While Filename <> ""

    Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True

    For Each Sheet In ActiveWorkbook.Sheets

      lr = Sheet.UsedRange.Rows(Sheet.UsedRange.Rows.Count).Row

      lc = Sheet.UsedRange.Columns(Sheet.UsedRange.Columns.Count).Column

      lr1 = sh.UsedRange.Rows(sh.UsedRange.Rows.Count).Row + 1

      Sheet.Range("A1", Sheet.Cells(lr, lc)).Copy sh.Range("A" & lr1)

    Next Sheet

    Workbooks(Filename).Close

    Filename = Dir()

  Loop

 

  Application.ScreenUpdating = True

End Sub




TIA
 

Attachments

  • screenshot of VBA error.PNG
    screenshot of VBA error.PNG
    47.8 KB · Views: 24
  • screenshot of files in their location.PNG
    screenshot of files in their location.PNG
    23.6 KB · Views: 32
Try this:

VBA Code:
Sub ImportInto1Tab()
  Dim sPath As String, sFile As String
  Dim wb As Workbook, sh As Worksheet, sh2 As Worksheet
  Dim lr1 As Long

  Application.ScreenUpdating = False

  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Sub
    sPath = .SelectedItems(1) & "\"
  End With
  sFile = Dir(sPath & "*.xls")
  Set sh = Sheets.Add(before:=Sheets(1))

  Do While sFile <> ""
    Set wb = Workbooks.Open(Filename:=sPath & sFile, ReadOnly:=True)
    For Each sh2 In wb.Sheets
      lr1 = sh.UsedRange.Rows(sh.UsedRange.Rows.Count).Row + 1
      sh2.Range("A1", sh2.UsedRange).Copy sh.Range("A" & lr1)
    Next
    wb.Close False
    sFile = Dir()
  Loop
  Application.ScreenUpdating = True
End Sub
 
Upvote 0

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Hi Dante

Thanks for the prompt response.

I tried that and it worked up to the part where it allows a user to select the folder they want to import the files from.

But then then the folder said "No items match your search" and the folder was empty." and the code stopped at this line:

If .Show <> -1 Then Exit Sub

The folder has 3 .xlsx files, so I added an 'x' at the end of the '.xls' in the code to see if it would make a difference. But it didn't....

Do you know why it wouldn't show any files to select, even though there are some .xlsx files in the folder?

I also changed a couple of the files to .xls files (without the 'x' at the end), but it still said the folder was empty?

Your help, so far, is greatly appreciated!

Thanks in advance.
 
Upvote 0
Change this
VBA Code:
sFile = Dir(sPath & "*.xls")

For this:
VBA Code:
sFile = Dir(sPath & "*.xls*")

They must select the folder correctly:

1597933604115.png
 
Upvote 0
Hmmm...I tried that, but it still doesn't show any files?

This is the udpdated code with the 'x' after the 's' in "*.xls"

I tried it without the 'x' as well..., but the files I have are .xlsx files.

VBA Code:
Sub ImportInto1Tab()
  Dim sPath As String, sFile As String
  Dim wb As Workbook, sh As Worksheet, sh2 As Worksheet
  Dim lr1 As Long

  Application.ScreenUpdating = False

  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Sub
    sPath = .SelectedItems(1) & "\"
  End With
  'sFile = Dir(sPath & "*.xlsx")
  sFile = Dir(sPath & "*.xlsx*")
  Set sh = Sheets.Add(before:=Sheets(1))

  Do While sFile <> ""
    Set wb = Workbooks.Open(Filename:=sPath & sFile, ReadOnly:=True)
    For Each sh2 In wb.Sheets
      lr1 = sh.UsedRange.Rows(sh.UsedRange.Rows.Count).Row + 1
      sh2.Range("A1", sh2.UsedRange).Copy sh.Range("A" & lr1)
    Next
    wb.Close False
    sFile = Dir()
  Loop
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
The code works for me.
You will have to go back to the previous version where you write the path in the code.
 
Upvote 0

Forum statistics

Threads
1,224,828
Messages
6,181,217
Members
453,024
Latest member
Wingit77

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top