Batch Import All XLS Files in Specific Folder into Masterfile

Manerlao

Board Regular
Joined
Apr 14, 2020
Messages
50
Office Version
  1. 2019
Platform
  1. Windows
Hi all!

Hope everyone is keeping well.

I have a small issue with my VBA and it would be great if someone could please help!

Basically, I have the following VBA which allows me to import an XLS or XLSB file into my Masterfile, and it is pasted under the current data. But I have to keep selecting multiple files each time for the import process.

Objective:


I would like to import all the XLS or XLSB files from within a selected folder and let the VBA loop through all the files for the import just like my code does. This would save me from selecting each individual file manually!:)
I have about 190 workbooks to import into the Master, so I don't want to click on 190 files! 😵

My Code:

VBA Code:
Sub Imp()

Dim fName As Variant, sh As Worksheet, wb As Workbook

CYCLE:
fName = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", Title:="Select a file")
    If fName = False Then Exit Sub
Set wb = Workbooks.Open(fName)

For Each sh In ThisWorkbook.Sheets
      If ShtExists(sh.Name, wb) Then
         wb.Sheets(sh.Name).UsedRange.Offset(1).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
      End If
   Next
    ans = MsgBox("Workbook " & Mid(fName, InStrRev(fName, "\") + 1) & " is incorporated.  Add more?", _
        vbYesNo, "Add more?")
        wb.Close False
    If ans = vbYes Then GoTo CYCLE:
    

MsgBox ("Ready.")
End Sub


Public Function ShtExists(ShtName As String, Optional Wbk As Workbook) As Boolean

    If Wbk Is Nothing Then Set Wbk = ActiveWorkbook
    On Error Resume Next
    ShtExists = (LCase(Wbk.Sheets(ShtName).Name) = LCase(ShtName))
    On Error GoTo 0

End Function

Please let me know if you have any ideas! Thank you in advance, this one has been challenging me for over a week now!
I can provide more information if required.

Thank you,
Manerlao
 

Some videos you may like

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
54,929
Office Version
  1. 365
Platform
  1. Windows
There are lots of posts out there on this. Here is one where Eric shows how you can loop through all Excel files in a folder.
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
54,929
Office Version
  1. 365
Platform
  1. Windows
You are welcome.

You would just imbed/nest your code in the middle of that loop, making a few minor modifications (for things like folder name).
 

Manerlao

Board Regular
Joined
Apr 14, 2020
Messages
50
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Yes, I will do some testing today. Appreciate it Joe! Thank you :)
 

Manerlao

Board Regular
Joined
Apr 14, 2020
Messages
50
Office Version
  1. 2019
Platform
  1. Windows
Hi Joe!

I hope you are keeping well.
I tried nesting my code in the code you recommended, however; I didn't have much luck.

Would you maybe know how this might be done?

Currently, my code looks like this:

VBA Code:
Sub OpenAndCalc()
Dim myDir As String, fn As String, SaveFlag As Boolean
Dim fName As Variant, sh As Worksheet, wb As Workbook

    Application.ScreenUpdating = False

    myDir = "C:\Users\admin\Desktop\ExcelFolder"
    fn = Dir(myDir & "*.xls*")

CYCLE:
fName = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", Title:="Please select a file")
    If fName = False Then Exit Sub
Set wb = Workbooks.Open(fName)
 '*****[Add Columns into the workbook before ingestion]*****
    Call AddColumnB
    Call AddColumnC
'*****************************************************************
 For Each sh In ThisWorkbook.Sheets
      If ShtExists(sh.Name, wb) Then
         wb.Sheets(sh.Name).UsedRange.Offset(1).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
      End If
   Next

    Do While fn <> ""
        Workbooks.Open (myDir & fn)
        SaveFlag = Not ActiveWorkbook.ReadOnly
        ActiveWorkbook.Close SaveFlag
        fn = Dir()
    Loop
    
End Sub

VBA Code:
Public Function ShtExists(ShtName As String, Optional Wbk As Workbook) As Boolean
'Function for MFIngestData_Adv()

    If Wbk Is Nothing Then Set Wbk = ActiveWorkbook
    
    On Error Resume Next
    ShtExists = (LCase(Wbk.Sheets(ShtName).Name) = LCase(ShtName))
    On Error GoTo 0

End Function

It's really quite a challenge, I have been trying for months to solve this.:confused:

I hope the VBA community can help me! Thank you, Joe and everyone!

Thank you very much and kind regards,
Manerlao
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
54,929
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

You do not have any loop for the opening of workbooks.
If you take a closer look at the reply in the link I provide, you will notice the Do/While loop to loop through all files.
You need to incorporate that into your code.
 

NdNoviceHlp

Well-known Member
Joined
Nov 9, 2002
Messages
2,586
Hi Manerlao. Joe4 has pointed U in the right direction but what you are requesting is fairly advanced. I have no idea re. power query and it may be well suited to what U want...I don't know? "been trying for months to solve this"... seems like a place I've been at before. So if you clear up a few things I'll give it a go. Are there non XL files in the folder? Are there more than 1 sheets in each XL file... if so do U want the info from each sheet. It seems like you are just wanting to copy 1 column from each sheet(file?) to the next available column available ... is this correct. What happens the 2nd time U run the VBA.. does it overwrite the data or append it to the data? Dave
 

Manerlao

Board Regular
Joined
Apr 14, 2020
Messages
50
Office Version
  1. 2019
Platform
  1. Windows
Dear Joe, Alansidman, Dave,

Thank you all for your very prompt replies to the challenge(s) I am having.

@Joe - yes, you are correct.

I will spend this week testing Joe's and Alansidman's advice and come back to you all soon. I believe Alansidman's Power Q. solution may be a quick fix, but I'll have to check the compatibility with my xls* files first.

Thank you very much and I will let you know my updates very soon.👨‍🏫

Best regards and appreciate all this advice. (By the way, I am still quite new to VBA/PQ, only started earlier this year).
Manerlao
 

Watch MrExcel Video

Forum statistics

Threads
1,114,528
Messages
5,548,570
Members
410,851
Latest member
glowe2020
Top