This negative energy just makes me stronger

In which we do things we never wanted to do with VBA - merge sheets from several Excel workbooks into a single workbook.

A coworker came to me a few days ago needing to merge a directory full of Excel workbooks into a single workbook to provide to a 3rd party.   Apparently each workbook is an extract/report of some sort, but the process that generates the files is unable to consolidate the report output into individual sheets in a single workbook.  What we have below is a quick and dirty macro I wrote to get the job done.

Problem:

You have a directory full of Excel workbooks

Each workbook has a single sheet containing data

You would like to consolidate the sheets into a single workbook

Solution:

Ensure all the workbooks are in the same directory

Open Excel

Press Alt + F11 to open Microsoft Visual Basic for Applications

Double click on ThisWorkbook on the left side under Projet - VBAProject

Paste the code below into the editor

Update the line path = "PATH TO YOUR EXCEL WORKBOOKS" by typing the path to your workbooks inside the quotes

Place your cursor anywhere inside the mergeWorkbooks() subroutine

Press F5 or click the green play button

When complete, you can close Microsoft Visual Basic for Applications

The open workbook will contain your merged data

Notes:

The comments indicate the variables you can change to adjust the range of columns to copy data from.

The final row is set to 65536 because I was working with workbooks in legacy format - adjust if you are using workbooks with more rows.

removeBlankSheets() is used to remove the original 3 sheets inserted by Excel when a workbook is opened as well as any other blank sheets.  It does so by checking if the first cell is blank.  You may need to adjust/remove this depending on your data.

Sub mergeWorkbooks()
    Dim path As String
    Dim startCol As String
    Dim startCell As Integer
    Dim endCol As String
    
    ' Path to currentWorkbook
    path = "PATH TO YOUR EXCEL WORKBOOKS"
    ' Set to Start Column
    startCol = "A"
    ' Set to Start Cell
    startCell = 1
    ' Set to End Column
    endCol = "IV"
    
    ' Keep a reference to the workbook we want to merge into
    Dim mainBook As Workbook
    Set mainBook = ThisWorkbook
	
    Dim currentWorkbook As Workbook
    Dim fileSystem As Object
    Dim directory As Object
    Dim files As Object
    Dim file As Object

    Application.ScreenUpdating = False
    Set fileSystem = CreateObject("Scripting.FileSystemObject")

    Set directory = fileSystem.Getfolder(path)
    Set files = directory.files
    For Each file In files
        Set currentWorkbook = Workbooks.Open(file)
        Range(startCol & startCell & ":" & endCol & Range(startCol & "65536").End(xlUp).Row).Copy

        ' Add a worksheet to paste into
        ' Who thought the syntax for after was a good idea?
        mainBook.Worksheets.Add After:=Worksheets(mainBook.Worksheets.Count)
        mainBook.Worksheets(mainBook.Worksheets.Count).Activate

        Range(startCol & "65536").End(xlUp).PasteSpecial

        Application.CutCopyMode = False
        currentWorkbook.Close
    Next
    
    ' Cleanup the sheets
    ThisWorkbook.removeBlankSheets
    ThisWorkbook.reNumberSheets
End Sub

Sub removeBlankSheets()
    ' Don't bother us
    Application.DisplayAlerts = False
    
    Dim sheet As Worksheet
    For Each sheet In Worksheets
        If sheet.Range("A1").Value = "" Then
            sheet.Delete
        End If
    Next sheet
    
    Application.DisplayAlerts = True
End Sub

Sub renumberSheets()
    ' Don't bother us
    Application.DisplayAlerts = False
    
    For i = 1 To ThisWorkbook.Worksheets.Count
        Sheets(i).Name = "Sheet" & i
    Next i
    
    Application.DisplayAlerts = True
End Sub
Loading