Zeesha has attended:
Excel VBA Introduction course
Importing data from multiple excel files
Hi,
I have written the VBA code below to collate data from multiple excel files into one worksheet of a master file. Can you please advise if there is anything I can do to speed up the process because I may need to import data from around 400 files. Any advice will be much appreciated. Please let me know if you have any questions. Thanks very much.
'Worksheets & Workbooks-------
Public src As Workbook
Public wsData As Worksheet
Public wsRaw As Worksheet
'Directories & Files---------
Public strImportDir As String
Public strImportFile As String
Sub ImportDataRaw() 'Import data from recording forms
Dim i As Integer
Dim lLastRow As Long
Application.ScreenUpdating = False
strImportDir = Application.ActiveWorkbook.Path & "\Import\" 'Directory for data file
strImportFile = Dir(strImportDir & "\*" & "xlsx") 'Type of file to import from directory
Set wsRaw = Application.ThisWorkbook.Worksheets("Raw Data") 'Worksheet where data needs to be imported
wsRaw.Activate
lLastRow = Cells(Rows.Count, 6).End(xlUp).Row 'Last row of wsRaw
i = lLastRow + 1
Do While Len(strImportFile) > 0
Set src = Workbooks.Open(strImportDir & strImportFile) 'set src as data file in import folder
Set wsData = src.Worksheets("Data") 'set wsData as worksheet that contains data to import
ThisWorkbook.Activate 'Activate template
wsRaw.Range(wsRaw.Cells(i, 1), wsRaw.Cells(i, 12)).Value2 = wsData.Range("A2:L2").Value2 'copy values
Workbooks(strImportFile).Close SaveChanges:=False 'Close data files and do not save changes
i = i + 1 'Next data file
strImportFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
RE: Importing data from multiple excel files
Hi Zeesha,
Thank you for the forum question.
If you use an array the code will run faster. There is a folder picker in my code.
I hope the code makes sense.
Option Explicit
Sub MergeAllWorkbooks()
'variable to store information in the computer's memory
Dim FolderPath As String 'store the folderpath in the computer's memory
Dim FileName As String 'store the file name inthe computer's memory
Dim WorkBk As Workbook 'store the name of each workbook in the computer's memory
Dim blankrow As Integer 'store the row number of the first blank row in destination sheet
Dim varAllData As Variant 'array. Will store all records from the source workbooks
'speed up macro. Stops Excel from updating screen while macro is running
Application.ScreenUpdating = False
'stops Excel from showing dialog boxes while running macro.
Application.DisplayAlerts = False
'open the select directory dialog box
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
'"IF THEN ELSE" decision code. If folder is selected then store the folder path in the variable folderpath
If .Show = -1 Then '-1 = yes or true
FolderPath = .SelectedItems(1) & "\"
'if folder is not selected the user will get a mesaage box and Excel will exit the macro
Else
MsgBox "FilePath not selected!", , "Path selecter"
Exit Sub
End If
End With
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.xl*")
' Loop until Dir returns an empty string.
Do While FileName <> ""
' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & "\" & FileName)
'add all data from eack workbook to the array
varAllData = WorkBk.Sheets(1).Range("a1").CurrentRegion.Offset(1, 0)
'will select the right destination sheet
ThisWorkbook.Sheets("Destination").Activate
'find the first blank row
blankrow = Range("a1").CurrentRegion.Rows.Count + 1
'"Empty" the array onto destination starting from column A and will get the right row number from the variable blankrow
'resize the destination for the data stored in the array varAllData
Range("A" & blankrow).Resize(UBound(varAllData, 1), UBound(varAllData, 2)) = varAllData
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
' Use Dir to get the next file name.
FileName = Dir()
'end of loop
Loop
End sub
Kind regards
Jens Bonde
Microsoft Office Specialist Trainer
Tel: 0207 987 3777
STL - https://www.stl-training.co.uk
98%+ recommend us
London's leader with UK wide delivery in Microsoft Office training and management training to global brands, FTSE 100, SME's and the public sector
