Excel VBA code to data consolidation from multiple sheets
Excel VBA code to consolidate data from the multiple sheets in one single Excel file
Sub SelectFolder()
'www.comexcelhub.com
Dim objFile As Object
Dim objFSO As Object
Dim objFolder As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim Cons_wb As Workbook
Dim Sour_wb As Workbook
Dim tb As ThisWorkbook
Set tb = ThisWorkbook
Dim mb As Worksheet
Set mb = tb.Sheets("sheet1")
Dim Mainfolderpath, Month_folder, sourcefilepath, unqfilename As String
Dim lrow1, lrow2, lrow3 As Integer
Dim pickdate As Date
Mainfolderpath = mb.Range("A2")
If mb.Range("D2") = "" Then
yr = Year(Date)
pickdate = DateValue("01-01-" & yr)
ElseIf mb.Range("D2") <> "" Then
pickdate = mb.Range("D2")
End If
Diff = mb.Range("B8").Value
con_path = ThisWorkbook.Path
con_filename = Range("G2")
Workbooks.Open (con_path & "\" & con_filename)
Set Cons_wb = ActiveWorkbook
For x = 1 To Diff
Month_folder = Application.WorksheetFunction.Text(pickdate, mb.Range("F2"))
sourcefilepath = Mainfolderpath & "\" & Month_folder
Set objFolder = objFSO.GetFolder(sourcefilepath)
For Each objFile In objFolder.Files
unqfilename = objFile.Name & "-" & Month_folder
Cons_wb.Sheets("Sheet1").Activate
Cons_wb.Sheets("Sheet1").Range("AA1") = Application.WorksheetFunction.CountIf(Range("A:A"), unqfilename)
If Cons_wb.Sheets("Sheet1").Range("AA1") >= 1 Then
GoTo Next_loop
End If
Workbooks.Open (objFile)
Set Sour_wb = ActiveWorkbook
Sour_wb.Sheets("Sheet1").Activate
lrow1 = Sour_wb.Sheets("Sheet1").Cells(Sour_wb.Sheets("Sheet1").Rows.Count, 1).End(xlUp).Row
Sour_wb.Sheets("Sheet1").Range("A2:C" & lrow1).Copy
Cons_wb.Sheets("Sheet1").Activate
lrow2 = Cons_wb.Sheets("Sheet1").Cells(Cons_wb.Sheets("Sheet1").Rows.Count, 1).End(xlUp).Row
Cons_wb.Sheets("Sheet1").Range("B" & lrow2 + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
lrow3 = Cons_wb.Sheets("Sheet1").Cells(Cons_wb.Sheets("Sheet1").Rows.Count, 2).End(xlUp).Row
Cons_wb.Sheets("Sheet1").Range("A" & lrow2 + 1 & ":A" & lrow3) = unqfilename
Sour_wb.Activate
Sour_wb.Close
Cons_wb.Sheets("Sheet1").Range("B2:B" & lrow3).NumberFormat = "DD-MM-YYYY"
Cons_wb.Sheets("Sheet1").Range("D2:D" & lrow3).NumberFormat = "$#,##"
Cons_wb.Sheets("Sheet1").Range("A2:D" & lrow3).Borders.LineStyle = xlContinuous
Cons_wb.Sheets("Sheet1").Columns("A:I").AutoFit
Next_loop:
Next objFile
pickdate = Application.WorksheetFunction.EDate(pickdate, 1)
Next x
Cons_wb.Save
Cons_wb.Close
MsgBox ("Files Consolidation Completed")
End Sub
Excel VBA Code Text File link: Click here
Excel File Link: Click here