Forum Discussion
ShazSh
Oct 06, 2021Brass Contributor
Code should create Master workbook in each folder separately in one go
Below code copy the multiple workbooks all sheets and paste these all sheet into new single workbook as sheets. I have more than 10 folders which have multiple workbooks with sheets. Currentl...
- Oct 07, 2021
Try this:
Dim wbkCurBook As Workbook Dim countFolders As Long Dim countFiles As Long Dim countSheets As Long Sub MergeExcelFiles() Dim fso As Object Dim fld As Object Dim sfl As Object Dim ParentFolder As String With Application.FileDialog(4) ' msoFileDialogFolderPicker If .Show Then ParentFolder = .SelectedItems(1) Else Beep Exit Sub End If End With Application.ScreenUpdating = False Application.Calculation = xlCalculationManual countFolders = 0 countFiles = 0 countSheets = 0 Set wbkCurBook = ActiveWorkbook Set fso = CreateObject(Class:="Scripting.FileSystemObject") Set fld = fso.GetFolder(ParentFolder) For Each sfl In fld.SubFolders Call ProcessFolder(sfl) Next sfl MsgBox "Processed " & countFiles & " files" & " in " & countFolders & " folders" & _ vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files" Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub Sub ProcessFolder(fld As Object) Dim fil As Object Dim wksCurSheet As Worksheet countFolders = countFolders + 1 Set wbkCurBook = Workbooks.Add(Template:=xlWBATWorksheet) For Each fil In fld.Files If LCase(fil.Name) Like "*.xls*" Then Call ProcessFile(fil) End If Next fil Application.DisplayAlerts = False wbkCurBook.Worksheets(1).Delete Application.DisplayAlerts = True For Each wksCurSheet In wbkCurBook.Worksheets If wksCurSheet.Range("A1").Value <> "" Then wksCurSheet.Name = wksCurSheet.Range("A1").Value wksCurSheet.Range("A1").EntireRow.Delete End If Next wksCurSheet wbkCurBook.SaveAs Filename:=fld.Path & "\" & fld.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook wbkCurBook.Close SaveChanges:=False End Sub Sub ProcessFile(fil As Object) Dim wbkSrcBook As Workbook Dim wksSrcSheet As Worksheet countFiles = countFiles + 1 Set wbkSrcBook = Workbooks.Open(Filename:=fil) For Each wksSrcSheet In wbkSrcBook.Worksheets countSheets = countSheets + 1 wksSrcSheet.Copy After:=wbkCurBook.Worksheets(wbkCurBook.Worksheets.Count) Next wbkSrcBook.Close SaveChanges:=False End Sub
ShazSh
Oct 07, 2021Brass Contributor
Sir i think i could not elaborate.
I want that if I have 1 folder which name is "Main Data" then there are 5 subfolders in it. which names are Folder 1,2,3,4 and 5 and there are 5 to 10 workbooks in each folder.
What i want is if i run the code and select the folder "Main Data" then code will be initiated on Folder "1" after completing the processing in Folder "1" code should create a "Master workbook" in that Folder for all the workbooks which are available in the Particular Folder.
Then same goes to other folders. Each folder should have their own "Master Workbook"
Current code created the single "Master Workbook" for all folders.
I want that if I have 1 folder which name is "Main Data" then there are 5 subfolders in it. which names are Folder 1,2,3,4 and 5 and there are 5 to 10 workbooks in each folder.
What i want is if i run the code and select the folder "Main Data" then code will be initiated on Folder "1" after completing the processing in Folder "1" code should create a "Master workbook" in that Folder for all the workbooks which are available in the Particular Folder.
Then same goes to other folders. Each folder should have their own "Master Workbook"
Current code created the single "Master Workbook" for all folders.
HansVogelaar
Oct 07, 2021MVP
Try this:
Dim wbkCurBook As Workbook
Dim countFolders As Long
Dim countFiles As Long
Dim countSheets As Long
Sub MergeExcelFiles()
Dim fso As Object
Dim fld As Object
Dim sfl As Object
Dim ParentFolder As String
With Application.FileDialog(4) ' msoFileDialogFolderPicker
If .Show Then
ParentFolder = .SelectedItems(1)
Else
Beep
Exit Sub
End If
End With
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
countFolders = 0
countFiles = 0
countSheets = 0
Set wbkCurBook = ActiveWorkbook
Set fso = CreateObject(Class:="Scripting.FileSystemObject")
Set fld = fso.GetFolder(ParentFolder)
For Each sfl In fld.SubFolders
Call ProcessFolder(sfl)
Next sfl
MsgBox "Processed " & countFiles & " files" & " in " & countFolders & " folders" & _
vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub ProcessFolder(fld As Object)
Dim fil As Object
Dim wksCurSheet As Worksheet
countFolders = countFolders + 1
Set wbkCurBook = Workbooks.Add(Template:=xlWBATWorksheet)
For Each fil In fld.Files
If LCase(fil.Name) Like "*.xls*" Then
Call ProcessFile(fil)
End If
Next fil
Application.DisplayAlerts = False
wbkCurBook.Worksheets(1).Delete
Application.DisplayAlerts = True
For Each wksCurSheet In wbkCurBook.Worksheets
If wksCurSheet.Range("A1").Value <> "" Then
wksCurSheet.Name = wksCurSheet.Range("A1").Value
wksCurSheet.Range("A1").EntireRow.Delete
End If
Next wksCurSheet
wbkCurBook.SaveAs Filename:=fld.Path & "\" & fld.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook
wbkCurBook.Close SaveChanges:=False
End Sub
Sub ProcessFile(fil As Object)
Dim wbkSrcBook As Workbook
Dim wksSrcSheet As Worksheet
countFiles = countFiles + 1
Set wbkSrcBook = Workbooks.Open(Filename:=fil)
For Each wksSrcSheet In wbkSrcBook.Worksheets
countSheets = countSheets + 1
wksSrcSheet.Copy After:=wbkCurBook.Worksheets(wbkCurBook.Worksheets.Count)
Next
wbkSrcBook.Close SaveChanges:=False
End Sub- ShazShOct 08, 2021Brass ContributorThank you it works perfect.