Link to home
Start Free TrialLog in
Avatar of Tom Crowfoot
Tom CrowfootFlag for United Kingdom of Great Britain and Northern Ireland

asked on

Excel VBA to Import all worksheets in all spreadsheets a folder into 1 single spreadsheet

Dear Experts
 
In Excel, I am trying to create a macro to import all the worksheets in all the spreadsheets (.xlsx) that are saved in a folder into 1 single spreadsheet called ‘Results.xlsx’.   


This is basically to automate a process which sees us downloading whatever data is available from pour source into separate spreadsheets & then use a template spreadsheet (the ‘Results.xlsx’) to consolidate the results & create graphs etc.


There are typically around 10-12 spreadsheets to import and each spreadsheet has 2 worksheets, one of which is called overview, the other has a unique name – I am not bothered about the worksheet called ‘Overview’ – this can either be ignored or overwritten as any code loops through.


The folder in question is the current folder path of the results spreadsheet for example:
 
C:\Users\tomcr\OneDrive\Desktop\Downloads\Results.xlsx
C:\Users\tomcr\OneDrive\Desktop\Downloads\To be imported (1).xlsx
C:\Users\tomcr\OneDrive\Desktop\Downloads\To be imported (2).xlsx
C:\Users\tomcr\OneDrive\Desktop\Downloads\To be imported (3).xlsx
C:\Users\tomcr\OneDrive\Desktop\Downloads\To be imported (4).xlsx
C:\Users\tomcr\OneDrive\Desktop\Downloads\To be imported (5).xlsx
 
Can anybody help?
 

Avatar of byundt
byundt
Flag of United States of America image

I wrote a set of folder traversing routines that will perform various data retrieval operations. The workbook containing them is attached to this thread. I believe the macro coming closest to your request is called FileFinder, and the action routine it should call is WorksheetImporter. The code below shows those subs.

Dim FileCount As Long

'Finds files of a specified name pattern within a user-specified folder

'The statements that need to be reviewed for changes should all have comments in green. _
    Pay particular attention to the patterns used in the InputBox statements in the first sub.
'Sub SearchFolder (at bottom of module) calls action routine FileLister. _
    You will probably want to test using FileLister because it runs quickly. _
    When satisfied, replace its call with one of the other action routines from module AltActionRoutines.

Sub FileFinder()
'Finds files of a specified name pattern within a user-specified folder. Does not search subfolders. _
    Retrieves data from every file with name like sFileNamePattern.
Dim sParentNamePattern As String, sFileNamePattern As String, TopFolderName As String
Dim ParentFolderObj As Object, TopFolderObj As Object
Dim nRows As Long
Dim celHome As Range
Dim wbDest As Workbook
Dim wsDest As Worksheet

Set wbDest = ActiveWorkbook                         'Copy data to this workbook
Set wsDest = wbDest.Worksheets(ReportWorksheet)     'Copy data to this worksheet (value set at top of AltActionRoutines
Set celHome = ActiveCell
FileCount = 0

'Define the folder to search
TopFolderName = Application.GetOpenFilename("Files (*.*), *.*", _
        Title:="Pick any file in desired top-most folder to search, then click Open")
If TopFolderName = "False" Then Exit Sub
TopFolderName = Left(TopFolderName, InStrRev(TopFolderName, Application.PathSeparator) - 1)
    
    'Specify pattern for filename. This pattern is last parameter in the InputBox statement. _
        Use wildcard characters * (any combination of characters, including none) and ? (any single character)
sFileNamePattern = InputBox("Enter the pattern for file name & extension", "Single folder file search routine", "*.xl*")
If sFileNamePattern = "" Then Exit Sub

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

wsDest.Cells.Clear                          'Clear the results worksheet
nRows = wsDest.UsedRange.Rows.Count         'Reset the row scrollbar
SearchFolder wsDest, TopFolderName, sFileNamePattern

Application.Goto celHome
Application.DisplayAlerts = True
Application.EnableEvents = True
'MsgBox "Done"
End Sub

Private Sub SearchFolder(wsDest As Worksheet, strPath As String, sFileNamePattern As String)
'In folder at strPath, look for files whose name matches sFileNamePattern _
    When found, call one of the action routines to capture data from that file and put it in worksheet wsDest _
    Test using FileLister as the action routine (it runs quickly), then replace with one of the others from module AltActionRoutines
Dim strFile As String, sName As String
strFile = Dir(strPath & Application.PathSeparator & sFileNamePattern)
Do While strFile <> ""
    FileCount = FileCount + 1
    If (MaxFiles > 0) And (FileCount > MaxFiles) Then Exit Do   'Value of MaxFiles is set in module AltActionRoutines
    'FileLister strPath, strFile, wsDest         'Call the action routine
    'WorksheetAppender strPath, strFile, wsDest  'Call the action routine
    'Summarizer strPath, strFile, wsDest         'Call the action routine
    'SummarizeByFormulas strPath, strFile, "Sheet1", wsDest      'Call the action routine
    'TextImporter strPath, strFile, wsDest       'Call the action routing
    WorksheetImporter strPath, strFile, wsDest  'Call the action routine
    
    strFile = Dir
Loop
End Sub

Sub WorksheetImporter(strPath As String, strFile As String, wsDest As Worksheet)
'Sample action routine
'Opens workbook strFile at path strPath, then copies its first worksheet to workbook containing wsDest _
    Names that worksheet after original file name (less file extension)
Dim f As String
Dim i As Long, j As Long, k As Long
Dim wb As Workbook, wbDest As Workbook

Set wbDest = wsDest.Parent
i = wbDest.Worksheets.Count
Set wb = Workbooks.Open(strPath & Application.PathSeparator & strFile)
f = wb.Name
k = InStrRev(f, ".")
wb.Worksheets(1).Copy after:=wbDest.Worksheets(i)
wbDest.Worksheets(i + 1).Name = Left(f, k - 1)
wb.Close SaveChanges:=False
'Kill strPath & Application.PathSeparator & strFile     'OPTIONAL: Delete the target file
    'OPTIONAL: Rename target file or move it to a different folder using Name statement
'Name strPath & Application.PathSeparator & strFile As strPath & Application.PathSeparator & "Processed " & strFile
End Sub

Open in new window

RecursiveFileAppender April 2016.xlsm
ASKER CERTIFIED SOLUTION
Avatar of Sam Jacobs
Sam Jacobs
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Tom Crowfoot

ASKER

thanks Sam, I'll give that a go @byundt - struggling slightly to get my head round your solution & getting it to work, but will give it another go this morning
@Sam - thats amazing - works perfectly, thank you so much!
@Tom ... you are most welcome.
@Sam - I can't get this to open on my Mac.  It will only open as read only.  Am, I missing something?

Thanks!

@Joey ... sorry, I'm strictly a Windows guy. Did you check the properties of the file on the Mac to make sure the Read-only checkbox is not selected?
User generated image
@Sam... Hello Sam, I did check the properties and it is read/write.  I discovered the issue is with ActiveX...  I don't know a workaround on this.  

Thanks.  I will try and get a hold of a windows machine.
@Joey ... if it's an ActiveX issue, try the below file, which uses the DIR function to enumerate files instead of the FileSystemObject (delete the original CombineSheets.xlm from the directory first).

CombineSheets2.xlsm
@Sam, Thanks for your help!!  I get the same ActiveX error:

This workbook contains content that isn't supported in this version of Excel.
".ActiveX"
Let me try one more thing ... give me a few minutes.
@Joey ... see if this one works.

CombineSheetsv3.xlsm
@Sam, Thank you!  that got all workbooks into one sheet with several tabs.  I think I can move forward with that.  Appreciate it.  I may reach out if I run into a problem.


You are welcome.

>> that got all workbooks into one sheet with several tabs.
That's what Tom had asked for. If you need something different, it would probably be best if you started a new question.