Merge Many Excel Files into one VBS

Download MergeExcel2.zip

Using the Code

Before you can run the script, you need to setup the configuration (MergeExcel.txt) file. In Windows Explorer, hold shift and right-click on the file you want to merge, select "Copy as path". Paste the path into MergeExcel.txt file. Each file in the file is the path to the Excel file to be merged. The configuration has to reside in the same folder as the VBS script.

c:\folder1\Excel1.xlsx
c:\folder1\Excel2.xlsx
c:\folder3\Excel3.xlsx

Double click to run MergeExcel.vbs. The script will read MergeExcel.txt file located in the same folder and imports all worksheets into one workbook. The script is using VBA to open Excel and import worksheets.

You can also drag and drop excel files on top of this script file to merge them.

Set fso = CreateObject("Scripting.FileSystemObject")
sConfigFilePath = GetFolderPath() & "\MergeExcel.txt"

if WScript.Arguments.Count > 0 then
    If WScript.Arguments.Count = 1 Then
    MsgBox "Please drag and drop more than one excel file on top of this script file."
    WScript.Quit
    End If
ElseIf fso.FileExists(sConfigFilePath) = False Then
    MsgBox "Could not file configuration file: " & sConfigFilePath & ". You can also drag and drop excel files on top of this script file."
    WScript.Quit
End If

Dim oExcel: Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = True
oExcel.DisplayAlerts = false
Set oMasterWorkbook = oExcel.Workbooks.Add()
Set oMasterSheet = oMasterWorkbook.Worksheets("Sheet1")
oMasterSheet.Name = "temp_delete"

Deletesheet oMasterWorkbook, "Sheet2"
Deletesheet oMasterWorkbook, "Sheet3"

if WScript.Arguments.Count > 0 then
    MergeFromArguments
Else
    MergeFromFile sConfigFilePath
End If

Deletesheet oMasterWorkbook, "temp_delete"
MsgBox "Done"

Sub MergeFromArguments()
    For i = 0 to WScript.Arguments.Count - 1
      sFilePath = WScript.Arguments(i)
  
      If fso.FileExists(sFilePath) Then

        If fso.GetAbsolutePathName(sFilePath) <> sFilePath Then
          sFilePath = fso.GetAbsolutePathName(sFilePath)
        End If

        Set oWorkBook = oExcel.Workbooks.Open(sFilePath)
    
        For Each oSheet in oWorkBook.Worksheets
          oSheet.Copy oMasterSheet
        Next
    
        oWorkBook.Close()
      End If
    Next
End Sub

Sub MergeFromFile(sConfigFilePath)
    Set oFile = fso.OpenTextFile(sConfigFilePath, 1)   
    Do until oFile.AtEndOfStream
      sFilePath = Replace(oFile.ReadLine,"""","")
  
      If fso.FileExists(sFilePath) Then

        If fso.GetAbsolutePathName(sFilePath) <> sFilePath Then
          sFilePath = fso.GetAbsolutePathName(sFilePath)
        End If

        Set oWorkBook = oExcel.Workbooks.Open(sFilePath)
    
        For Each oSheet in oWorkBook.Worksheets
          oSheet.Copy oMasterSheet
        Next
    
        oWorkBook.Close()
      End If
    Loop
    oFile.Close
End Sub

Function GetFolderPath()
    Dim oFile 'As Scripting.File
    Set oFile = fso.GetFile(WScript.ScriptFullName)
    GetFolderPath = oFile.ParentFolder
End Function

Sub Deletesheet(oWorkbook, sSheetName)
  on error resume next
  oWorkbook.Worksheets(sSheetName).Delete
End Sub

This script lets you merge multiple excel files into single worksheet.

if WScript.Arguments.Count = 0 then
    MsgBox "Please drag and drop a folder on top of this script file to merge sheets into single sheet."
    WScript.Quit
End If

Set fso = CreateObject("Scripting.FileSystemObject")
sFolderePath = WScript.Arguments(0)

If fso.FolderExists(sFolderePath) = False Then
  MsgBox "Could not find folder: " & sFolderePath 
  WScript.Quit
End If

If MsgBox("Merge worksheets for this folder: " & sFolderePath, vbYesNo + vbQuestion) = vbNo Then
  WScript.Quit
End If

Set oFolder = fso.GetFolder(sFolderePath)

Dim oExcel: Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = True
oExcel.DisplayAlerts = false

Set oMasterWorkbook = oExcel.Workbooks.Add()
Set oCombined = oMasterWorkbook.Worksheets("Sheet1")
iRowOffset = 0

For Each oFile In oFolder.Files
    If oFile.Attributes And 2 Then
        'Hidden
    Else

        Set oWorkbook = oExcel.Workbooks.Open(oFile.Path)
        Set oSheet = oWorkbook.Worksheets(1)
        iRowsCount = GetLastRowWithData(oSheet)

        If iRowOffset = 0 Then 
            iStartRow = 4
        Else 
            iStartRow = 5
        end if

        oSheet.Range(oSheet.Cells(iStartRow, 1), oSheet.Cells(iRowsCount, oSheet.UsedRange.Columns.Count)).Copy
        oCombined.Activate
        oCombined.Cells(iRowOffset + 1, 1).Select
        oCombined.Paste       

        iRowOffset = iRowOffset + iRowsCount - iStartRow + 1
        oWorkbook.Close
    End If
Next

MsgBox "Done!"

Function GetLastRowWithData(oSheet)
    iMaxRow = oSheet.UsedRange.Rows.Count
    If iMaxRow > 500 Then
        iMaxRow = oSheet.Cells.Find("*", oSheet.Cells(1, 1),  -4163, , 1, 2).Row
    End If

    For iRow = iMaxRow to 1 Step -1
         For iCol = 1 to oSheet.UsedRange.Columns.Count
            If Trim(oSheet.Cells(iRow, iCol).Value) <> "" Then
                GetLastRowWithData = iRow
                Exit Function
            End If
         Next
    Next
    GetLastRowWithData = 1
End Function

History

• 13^th April, 2020: Initial version