Excel VBA: How to Merge Multiple Workbooks to One from a Folder

Ever Wonder to Copy all the Workbooks into one Workbook.
In this post i will share the script to copy all the excel files from one folder to Single Excel File.

Below is the Script

Sub MergeMultipleWorkbooks()

'Define Variables
Dim Path, FileName As String

'Assign Values to Variables
Path = Assign a Folder  which contains excel files for example "C:\Merge\"
FileName = Dir(Path & "*.xlsx")

'Check FileName in the Given Location
Do While FileName <> ""

'Open Excel File
Workbooks.Open FileName:=Path & FileName, ReadOnly:=True

'Copy all the sheet to this workbook
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet

'Close the ActiveWorkbook
Workbooks(FileName).Close
'Assign a Excel FileName

'Assign Next Excel FileName
FileName = Dir()
Loop

'Display a Message
MsgBox "Files has been copied Successfull", , "MergeMultipleExcelFiles"
End Sub

See it in Action.

Excel VBA: How to Merge Multiple Sheet into One Sheet

Merging more than one sheets in excel may be time consuming. But with the below VBA code it will only take few seconds to complete the task.

Below is the VBA Code.

Sub MergeSheet()

'Declaring the Variables
Dim LastRow, ShtCnt As Integer
Dim ShtName As String
Dim NewSht As Worksheet

'Assinging a Sheet Name by UserInput
ShtName:
ShtName = InputBox("Enter the Sheet Name you want to create", "Merge Sheet", "Master Sheet")

'Count of Total Worksheet in the present workbook
ShtCnt = Sheets.Count

'Using For Loop check if the worksheet exists
For i = 1 To ShtCnt
If Sheets(i).Name = ShtName Then
MsgBox "Sheet already Exists", , "Merge Sheet"
GoTo ShtName
End If
Next i

'Create a New Sheet
Worksheets.Add.Name = ShtName

'Assigning NewSht as Current Sheet
Set NewSht = ActiveSheet

'Moving Worksheet to the beginning of this workbook
NewSht.Move before:=Worksheets(1)

'Copying all the data to the New Sheet Using For Loop
For i = 2 To ShtCnt + 1

'If i=2 Then copy all the data from the second sheet including header.
If i = 2 Then
Sheets(i).UsedRange.Copy NewSht.Cells(1, 1)
Else

'If i is grater than 2 then copy all the data excluding Header(1st Row).
Sheets(i).UsedRange.Offset(1, 0).Resize(Sheets(i).UsedRange.Rows.Count - 1, Sheets(i).UsedRange.Columns.Count).Copy NewSht.Cells(LastRow + 1, 1)
End If
LastRow = NewSht.Cells.SpecialCells(xlCellTypeLastCell).Row
Next i

'Displaying the Message after copying data successfully
MsgBox "Data has been copied to " & ShtName, , "Merge Sheet"

End Sub

See it in Action.

Excel VBA: How to Extract Data from Excel to Text File

In this post we are going to see how to export data from excel to text file using VBA.

Below is the VBA Code.

Sub ExceltoText()

'Declaring the variables
Dim FileName, sLine, Deliminator As String
Dim LastCol, LastRow, FileNumber As Integer

'Excel Location and File Name
FileName = Thisworkbook.path & "\ExceltoText.txt"

'Field Separator
Deliminator = "|"

'Identifying the Last Cell
LastCol = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
FileNumber = FreeFile

'Creating or Overwrighting a text file
Open FileName For Output As FileNumber

'Reading the data from Excel using For Loop
For i = 1 To LastRow
For j = 1 To LastCol

'Removing Deliminator if it is wrighting the last column
If j = LastCol Then
sLine = sLine & Cells(i, j).Value
Else
sLine = sLine & Cells(i, j).Value & Deliminator
End If
Next j

'Wrighting data into text file
Print #FileNumber, sLine
sLine = ""
Next i

'Closing the Text File
Close #FileNumber

'Generating message to display
MsgBox "Text file has been generated"

End Sub

See it in action.