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
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.