Click here to Skip to main content
14,602,799 members

Merge Many Excel Files into one VBS

Rate this:
4.13 (7 votes)
Please Sign up or sign in to vote.
4.13 (7 votes)
14 Jul 2020CPOL
This VBS will merge Many Excel files into one
This MergeExcel.vbs will merge Many Excel files into one. Double click to run it. It will read MergeExcel.txt file located in the same folder and imports all worksheets into one workbook.

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

  • 13th April, 2020: Initial version

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Share

About the Author

Igor Krupitsky
Web Developer
United States United States
Igor is a business intelligence consultant working in Tampa, Florida. He has a BS in Finance from University of South Carolina and Masters in Information Management System from University of South Florida. He also has following professional certifications: MCSD, MCDBA, MCAD.

Comments and Discussions

 
QuestionSuggestion Pin
Ron Mittelman21-Apr-20 13:16
MemberRon Mittelman21-Apr-20 13:16 
AnswerRe: Suggestion Pin
Igor Krupitsky2-May-20 10:19
mvaIgor Krupitsky2-May-20 10:19 
QuestionMissing Code? Pin
Ron Mittelman21-Apr-20 13:05
MemberRon Mittelman21-Apr-20 13:05 
AnswerRe: Missing Code? Pin
Igor Krupitsky2-May-20 10:15
mvaIgor Krupitsky2-May-20 10:15 
The script opens new Excel workbook (Set oMasterWorkbook = oExcel.Workbooks.Add()) and copies worksheets from other workbooks to it

Have you tried to run the code?
GeneralRe: Missing Code? Pin
Ron Mittelman2-May-20 16:20
MemberRon Mittelman2-May-20 16:20 
QuestionMerge excel files Pin
Member 408840114-Apr-20 6:46
MemberMember 408840114-Apr-20 6:46 
AnswerRe: Merge excel files Pin
Igor Krupitsky14-Apr-20 10:39
mvaIgor Krupitsky14-Apr-20 10:39 
GeneralRe: Merge excel files Pin
Member 408840114-Apr-20 22:49
MemberMember 408840114-Apr-20 22:49 
GeneralRe: Merge excel files Pin
Igor Krupitsky15-Apr-20 2:53
mvaIgor Krupitsky15-Apr-20 2:53 
GeneralRe: Merge excel files Pin
Member 408840115-Apr-20 3:10
MemberMember 408840115-Apr-20 3:10 
GeneralRe: Merge excel files Pin
Igor Krupitsky15-Apr-20 3:39
mvaIgor Krupitsky15-Apr-20 3:39 
GeneralRe: Merge excel files Pin
Member 408840115-Apr-20 5:02
MemberMember 408840115-Apr-20 5:02 
GeneralRe: Merge excel files Pin
Igor Krupitsky15-Apr-20 10:54
mvaIgor Krupitsky15-Apr-20 10:54 
GeneralRe: Merge excel files Pin
Member 408840115-Apr-20 21:46
MemberMember 408840115-Apr-20 21:46 
GeneralRe: Merge excel files Pin
Igor Krupitsky16-Apr-20 5:42
mvaIgor Krupitsky16-Apr-20 5:42 
GeneralRe: Merge excel files Pin
Member 408840116-Apr-20 22:17
MemberMember 408840116-Apr-20 22:17 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.

Tip/Trick
Posted 13 Apr 2020

Tagged as

Stats

6.4K views
129 downloads
2 bookmarked