Sub Consolidation()
Application.DisplayAlerts = False
Dim j As Integer
Sheets("ConsolidatieNaam").Range("A11:X1000000").ClearContents
Range("A5").Select
Application.ScreenUpdating = False
For j = 0 To 2
Path = Worksheets("Sheet2").Range("B79").Offset(j, 0)
For Each fl In CreateObject("scripting.filesystemobject").GetFolder(Path).Files
With Workbooks.Add(fl)
ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1) = fl
ThisWorkbook.UpdateRemoteReferences = False
Application.DefaultWebOptions.UpdateLinksOnSave = False
.Sheets(1).UsedRange.Copy
ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial -4163
.Close False
End With
Next
Next j
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub Example2()
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim i As Integer
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("C:\...\a")
i = 1
'loops through each file in the directory and prints their names and path
For Each objSubFolder In objFolder.subfolders
'print folder name
Cells(i + 1, 1) = objSubFolder.Name
'print folder path
Cells(i + 1, 2) = objSubFolder.Path
i = i + 1
Next objSubFolder
End Sub