Loop files in one folder

Hi Freddie,

I have used an array instead of copy and paste. THis is much faster and better in VBA. Stay away from copy and paste in your code. It will give you a lot of problems.

The code will take all records from sheet one from all the workbooks in the folder you select. You will need to change the name of the destination sheet in the code. In my code all lists start from row 1. If you tables/lists start from another row, you will have to change the code.


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 Long '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
'error handling. If there is an error Excel will go to the bottom of the macro where the error name is
'On Error GoTo ErrHandler





'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
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub









Kind regards

Jens Bonde
Microsoft Office Specialist Trainer

Tel: 0207 987 3777
Best 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