Consolidating Several Worksheets from Different Workbooks using Macro

I have been using MS Excel before whenever I had to make grades for my classes but never did I think that I shall be using MS Excel to create programs or what they call VBA as I have been using only Java or C# with MySQL or Oracle for database programming.

So, working now as an Excel Trainer cum Reports Analyst, I have to create small macro programs that will aid the office in report generation. So, let me share, a simple Macro Program to that shall consolidate / combine different worksheets from several workbooks into one summary file.

I hope these will help you in your macro learning.

different worksheets of different workbooks

These files were saved in one folder, and the idea is to combine different data from different worksheet and combine them all in one separate workbook say in a different folder.

the summary file (some rows were hidden for visual purpose)

So, in my Summary File, I write these:

Sub createSummarySheet()
Dim SummarySht As Worksheet
Dim FolderPath As String
Dim BlankRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim lastrow As Long

Set SummarySht = ActiveWorkbook.Worksheets(1)
FolderPath = "C:\Tickets\"  'this is the folder where you will save your different workbooks for consolidation

BlankRow = 2
FileName = Dir(FolderPath & "*.xl*")
SummarySht.Range("A2:D" & SummarySht.Rows.Count).ClearContents


Do While FileName <> ""
    Set WorkBk = Workbooks.Open(FolderPath & FileName)
   
    'call combine function
    Combine
    SummarySht.Range("A" & BlankRow).Value = FileName
   
    lastrow = WorkBk.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
 
    Set SourceRange = WorkBk.Worksheets(1).Range(Cells(2, 1), Cells(lastrow, 3))
    Set DestRange = SummarySht.Range("B" & BlankRow)
    Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
    DestRange.Value = SourceRange.Value
    BlankRow = BlankRow + DestRange.Rows.Count
    WorkBk.Close saveChanges:=False
    FileName = Dir()
Loop

SummarySht.Columns.AutoFit


SummarySht.Range("A1:D" & SummarySht.UsedRange.Rows.Count).Borders.LineStyle = xlContinuous
ActiveWorkbook.Save
 
 
End Sub
----
In  another module to combine the different worksheets before being captured into summary file, I write these:

Sub Combine()
    Dim J As Integer

    On Error Resume Next
    Sheets(1).Select
    Worksheets.Add ' add a sheet in first place
    Sheets(1).Name = "Sheet1"

    ' copy headings
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")

    ' work through sheets
    For J = 2 To Sheets.Count ' from sheet 2 to last sheet
        Sheets(J).Activate ' make the sheet active
        Range("A1").Select
        Selection.CurrentRegion.Select ' select all cells in this sheets

        ' select all lines except title
        Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select

        ' copy cells selected in the new sheet on last line
        Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
    Next
    Worksheets("Sheet1").Activate
 
End Sub