Importing multiple files into one tab instead of separate tabs

Mr2017

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

I've got some code that imports multiple files into one single file.

However, each file that is imported is put into a separate tab in the single file.

I would prefer to have append the data from the multiple files, instead of having it on separate tabs.

Does anyone know how to modify the code below so that the data from the multiple files would be appended in one single tab in the single file?

Thanks in advance.

Code:
Sub Import()

Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = Environ("userprofile") & "\Desktop\Test\"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
 Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
 For Each Sheet In ActiveWorkbook.Sheets
 Sheet.Copy After:=ThisWorkbook.Sheets(1)
 Next Sheet
 Workbooks(Filename).Close
 Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub
 
Last edited:

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
Try this

Code:
Sub Import()
  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
  FolderPath = Environ("userprofile") & "\Desktop\Test\"
  FolderPath = "C:\trabajo\"
  Filename = Dir(FolderPath & "*.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
 
Upvote 0
Hi Dante

Thanks for the prompt response.

I tried that, but it didn't work.... Not sure why, though?

It creates a new tab in the single file, but it doesn't actual import any data?

Please let me know if you need some more detail?

Thanks in advance.
 
Upvote 0
Delete this line

Code:
[COLOR=#333333]FolderPath = "C:\trabajo\"[/COLOR]
 
Upvote 0
Awesome!

Thank you!

It's working, as intended, now.

Thanks again!
 
Upvote 0
I'm sorry, I forgot to delete that line that I used for my tests.

I'm glad to help you, thanks for the feedback.
 
Upvote 0
Hi Dante

Thanks for your help, so far.

Do you know if it's possible to add something to the code which

i) tells you which files (based on the value of cell A4 in each file to be imported) have been imported, after the multiple import is done? Each file (to be imported) has a unique value in cell A4 eg File 1 has 'Apples' in cell A4. File 2 has 'Oranges' in cell A4. Files 3 has 'Pears' in cell A4.

ii) checks if a particular file has already been imported into the single file (based on the data in cell A4 in the files to be imported) and tells a user if it has?

Thanks in advance.
 
Upvote 0
Hi Dante

Thanks for your help, so far.

Do you know if it's possible to add something to the code which

i) tells you which files (based on the value of cell A4 in each file to be imported) have been imported, after the multiple import is done? Each file (to be imported) has a unique value in cell A4 eg File 1 has 'Apples' in cell A4. File 2 has 'Oranges' in cell A4. Files 3 has 'Pears' in cell A4.

Where do you want to put that information?
You can explain it with complete examples.

ii) checks if a particular file has already been imported into the single file (based on the data in cell A4 in the files to be imported) and tells a user if it has?
You can explain it with complete examples.



Thanks in advance.

Please comment.
 
Upvote 0
Hi Dante

Please find below the info requested:

Let’s assume you have 3 files:

“File A” – which has the word “Apples” in cell A4

“File B” – which has the word “Oranges” in cell A4

“File B(1)” – which has the word “Oranges” in cell A4

NB File B(1) is the same as File B. The only difference is that File B was downloaded again, so the new file was given the name B(1).xlxs

The steps:

1)Import multiple files from the “Fruits” folder on the Desktop (I’ve changed the folder name from "Test" to "Fruits" and also changed the word “Test” to “Fruits” in the revised code, at the bottom of this, for your convenience).

2) When the data is imported from each file, the first record is pasted into cell A1 of the the Single file (with the data being appended, as it is currently).

3) Have a message box that pops up after all the files in the folder have been imported, saying “You’ve imported x number of files” and lists the file names of each file, using the name in cell A4 of each file.

4) A second message box would advise if there are any files that have already been imported before / duplicates, again using the cell reference in A4 of those files.

Does that make sense?

Code:
Sub ImportMultipleFilesFruitsFolder()  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
  FolderPath = Environ("userprofile") & "\Desktop\Fruits\"
  Filename = Dir(FolderPath & "*.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
 
Upvote 0

Forum statistics

Threads
1,214,400
Messages
6,119,288
Members
448,885
Latest member
LokiSonic

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