Wednesday, September 21, 2016

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
    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()


SummarySht.Range("A1:D" & SummarySht.UsedRange.Rows.Count).Borders.LineStyle = xlContinuous
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
    Worksheets.Add ' add a sheet in first place
    Sheets(1).Name = "Sheet1"

    ' copy headings
    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
        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)
End Sub

No comments: