Consolidation of Worksheets
Public CodingWkb As Workbook, CodingSh As Worksheet
Public InputWkb As Workbook
Public OutputWkb As Workbook, OutputSh As Worksheet
Sub Consolidate_Worksheets()
Application.ScreenUpdating = False
'==========Define Coding Workbook and Worksheet========
Set CodingWkb = ActiveWorkbook
Set CodingSh = CodingWkb.Sheets("Buttons")
'===========Delete the worksheet names data in buttons tab
If CodingSh.Range("A1").CurrentRegion.Rows.Count > 1 Then
CodingSh.Range("A2:B" & CodingSh.Range("A" & Rows.Count).End(xlUp).Row).ClearContents
End If
'=============Select the Workbook==========
Dim fileName As String
fileName = Application.GetOpenFilename()
UserForm1.TextBox1.Value = fileName
UserForm1.TextBox1.TextAlign = fmTextAlignLeft
'============Open the Workbook============
Workbooks.Open (fileName)
Set InputWkb = ActiveWorkbook
Dim Sh As Worksheet
For Each Sh In InputWkb.Worksheets
UserForm1.ListBox1.AddItem Sh.Name
Next
UserForm1.Show
Application.SheetsInNewWorkbook = 3
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Function Nullifying_The_Variables()
NewWorkbook = ""
Header = ""
TotalWorkSheets = ""
Set CodingWkb = Nothing
Set CodingSh = Nothing
Set InputWkb = Nothing
Set InputSh = Nothing
Set OutputWkb = Nothing
Set OutputSh = Nothing
q = 0
fr = 0
fc = 0
i = 0
End Function
Private Sub CommandButton1_Click()
'Applying Application Object Properties
Application.DisplayAlerts = False
Application.SheetsInNewWorkbook = 1
'Save the Selected worksheet names in a variable based on Listbox Selection
Dim TotalWorkSheets As String
TotalWorkSheets = ""
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
TotalWorkSheets = TotalWorkSheets & "," & Me.ListBox1.List(i)
End If
Next
TotalWorkSheets = Right(TotalWorkSheets, Len(TotalWorkSheets) - 1)
'=======Define the output workbook based on Option button selection
SavedTime = Format(Now(), "YYYY_MM_DD_HH_SS")
If Me.OptionButton1.Value = True Then
NewWorkbook = "Yes"
Set OutputWkb = Workbooks.Add
Set OutputSh = OutputWkb.ActiveSheet
OutputSh.Name = "Consolidated" & SavedTime
End If
If Me.OptionButton2.Value = True Then
Set OutputWkb = Workbooks(InputWkb.Name)
Set OutputSh = OutputWkb.Sheets.Add(after:=OutputWkb.Sheets(Sheets.Count))
OutputSh.Name = "Consolidated" & SavedTime
End If
'================Confirm Header exists or not ========
If Me.CheckBox1.Value = True Then
Header = "Yes"
End If
'==============Unload the Userform====================
Unload Me
OutputSh.Activate
ActiveWindow.DisplayGridlines = False
Dim fc As Integer, fr As Integer, q As Integer
fc = 1: fr = 1
'=============Split the worksheet names based on comma
PostsplitWorkSheets = Split(TotalWorkSheets, ",")
Dim ShLastRow As Integer
'=============Loop through all the worksheets
For i = 0 To UBound(PostsplitWorkSheets)
s = PostsplitWorkSheets(i)
InputWkb.Worksheets(s).Activate
Lastcol = Range(Range("A" & fc), Range("A" & fc).End(xlToRight)).Columns.Count
LastRow = Range(Range("A" & fr), Range("A" & fr).End(xlDown)).Rows.Count
If i = 0 Then
q = 1
Range(Cells(q, 1), Cells(LastRow, Lastcol)).Select
Selection.Copy
End If
If i <> 0 Then
If Header = "Yes" Then
q = 2
Else:
q = 1
End If
Range(Cells(q, 1), Cells(LastRow, Lastcol)).Select
Selection.Copy
End If
OutputSh.Activate
If i = 0 Then
OutputSh.Range("A1").PasteSpecial Paste:=xlPasteAll
Else:
Last = OutputSh.Range("A" & Rows.Count).End(xlUp).Row + 1
OutputSh.Cells(Last, 1).PasteSpecial Paste:=xlPasteAll
End If
Application.CutCopyMode = False
ShLastRow = CodingSh.Range("A" & Rows.Count).End(xlUp).Row + 1
CodingSh.Cells(ShLastRow, 1).Value = s
Next
'===========Format The Output Worksheet======
OutputSh.UsedRange.Select
With Selection
.Font.Size = 18
.Font.Name = "Footlight MT Light"
.Cells.EntireColumn.AutoFit
.Cells.Borders.ColorIndex = 1
.Cells.Borders.LineStyle = xlContinuous
.Cells.Borders.Weight = 3
ActiveWindow.DisplayGridlines = False
End With
'If output sheet in new workbook save the workbook
If NewWorkbook = "Yes" Then
OutputWkb.SaveAs fileName:=CodingWkb.Path & "\" & "OutputWkb_" & SavedTime & ".xlsx"
InputWkb.Close
End If
OutputWkb.Save
OutputWkb.Close
Application.DisplayAlerts = True
Nullifying_The_Variables
Application.Speech.Speak ("Hi " & Application.UserName & " Consolidation Process Completed")
MsgBox "Hi Consolidation Process Completed"
End Sub