Merging Workbooks in Excel Automatically Using VBA (Part-2)

In my previous article, I shared a code snippet for merging .CSV files, but I'm thrilled to deliver on my promise of an enhanced solution. Today, I present to you a code that can merge Excel workbooks seamlessly. Get ready to unlock a new level of efficiency in your data management journey.

If you are new and don't know how to unlock VBA window, you can learn the process till code pasting from here. In this article I'll provide you with the code only.

The Game-Changing Code:

With this meticulously crafted code, you can now merge multiple Excel workbooks effortlessly. Simply execute the code, and watch as your workbooks merge into a cohesive whole. Say goodbye to manual merging and hello to streamlined processes.

Benefits of the Enhanced Solution:

By embracing this upgraded code, you'll experience a host of advantages:

Time Savings: Eliminate the tedious manual process of merging workbooks. Let the code do the heavy lifting while you focus on more valuable tasks.

Error Reduction: By automating the merging process, you minimize the risk of human errors, ensuring accurate and reliable results.

Enhanced Productivity: Harness the power of automation to boost your productivity and free up time for critical analysis and decision-making.

Here is the code.

Copy the code from below.

Sub MergeDataFromFolder()

Dim copiedsheetcount As Long

Dim rowcnt As Long

Dim merged As Workbook

Dim wb As Workbook

Dim ws As Worksheet

filefolder = "D:\Files\"

Filename = Dir(filefolder & "*.xlsx")

If Filename = vbNullString Then

MsgBox prompt:="No File", Buttons:=vbCritical, Title:="error"

Exit Sub

End If

copiedsheetcount = 0

rowcnt = 1

Set merged = Workbooks.Add

ActiveSheet.Name = "Merged Data"

Do While Filename <> vbNullString

copiedsheetcount = copiehsheetcount + 1

Set wb = Workbooks.Open(Filename:=filefolder & Filename, UpdateLinks:=False)

Set ws = wb.Worksheets(1)

With ws

If FilterMode Then .ShowAllData

If copiedsheetcount > 1 Then .Rows(1).EntireRow.Delete shift:=xlUp

.Range("a1").CurrentRegion.Copy Destination:=merged.Worksheets(1).Cells(rowcnt, 1)

End With

wb.Close savechanges:=False

rowcnt = Application.WorksheetFunction.CountA(merged.Worksheets(1).Columns("A:A")) + 1

Filename = Dir

Loop

MsgBox prompt:="File Merged", Buttons:=vbInformation, Title:="Success"

End Sub

The Code ends at "End Sub" above.

Now you have single excel sheet with all the merged data from different workbook to analyze and check at one place.