Search

VBA to Consolidate Sheets from all Files within a Folder

In this new series 'Plug & Play', we'll show you all cool VBA codes that you can use to automate your work and significantly improve your efficiency. All codes in these series are ready for use with little or no change at all.

No prerequisites: You do not need prior programming experience to use this however, you are expected to have a basic understanding of Excel.

If you have any questions/feedback/tutorial request, please feel to comment below or directly email us at vbaa2z.team@gmail.com and I will try and come back as soon as possible.

Tutorial link: https://youtu.be/cjt5qEuidDE


Option Explicit

Public PriorCalcMode As Variant

Private Sub combine_all_sheets_of_filesInDir()

'-----------------------------
'Thanks for downloading the code. 
'Please visit our channel for a quick explainer on this code.
'Feel free to update the code as per your need and also share with your friends.
'Channel: Youtube.com/vbaa2z
'Download free codes from http://vbaa2z.blogspot.com
'Author: L Pamai (vbaa2z.team@gmail.com)
'-----------------------------

Dim masterWb As Workbook
Dim curWb As Workbook
Dim DirPath As String
Dim Filename As String
Dim sh As Worksheet
Dim outputfilefolder As String, outputfile_name As String

On Error GoTo combine_all_sheets_of_filesInDir_ERR

code_booster True

DirPath = "D:\VBAA2Z Demo\Reports\"
Filename = Dir(DirPath & "*.xls*")
outputfilefolder = "D:\VBAA2Z Demo\Reports\"
outputfile_name = "final " & Format(Now(), "yyyymmdd-hhmmssampm")

Set masterWb = Workbooks.Add

Do While Filename <> ""

    Debug.Print DirPath & Filename
    
    Set curWb = Workbooks.Open(Filename:=DirPath & Filename, ReadOnly:=True, UpdateLinks:=False)
    
    For Each sh In curWb.Sheets
        sh.Copy After:=masterWb.Sheets(1)
    Next sh
    
    curWb.Close False
    Filename = Dir()
    
Loop

masterWb.SaveAs Filename:=outputfilefolder & outputfile_name, FileFormat:=xlOpenXMLWorkbook
code_booster False

MsgBox "Process Completed Successfully", vbInformation, "Unexpected Error VBA A2Z"

Exit Sub
combine_all_sheets_of_filesInDir_ERR:

code_booster False

MsgBox Err.Description & ". " & Err.Number, vbCritical, "Unexpected Error VBA A2Z"

End Sub

Public Function code_booster(SpeedMode As Boolean)
    
    With Application
    
        If SpeedMode = True Then
            PriorCalcMode = Application.Calculation
            .ScreenUpdating = False
            .DisplayAlerts = False
            .EnableEvents = False
            .Cursor = xlWait
            .Calculation = xlCalculationManual
        Else
        
            .ScreenUpdating = True
            .DisplayAlerts = True
            .EnableEvents = True
            .StatusBar = False
            .Cursor = xlDefault
        .Calculation = PriorCalcMode
        
        End If
    End With

End Function


No comments:

Post a Comment

Note: only a member of this blog may post a comment.