Back to Blog
2 min read

Merging Excel Files

A quick reference for VBA code snippets to merge multiple Excel files and sheets.

tutorialbasicsOffice 中文

For the detailed steps, you’ll need to check the tutorial. I’m just noting down the different code snippets here for my own reference.

=VLOOKUP($B2,Sheet1!$B$2:$H$400,COLUMN(F1),0)&""

1. Merge all files into one sheet

Sub 合并当前目录下所有工作簿的全部工作表到一个新的工作表()
    Dim MyPath, MyName, AWbName
    Dim Wb As workbook, WbN As String
    Dim G As Long
    Dim Num As Long
    Dim BOX As String
    Application.ScreenUpdating = False
    MyPath = ActiveWorkbook.Path
    MyName = Dir(MyPath & "\" & "*.xlsx")
    AWbName = ActiveWorkbook.Name
    Num = 0
    Do While MyName <> ""
    If MyName <> AWbName Then
    	Set Wb = Workbooks.Open(MyPath & "\" & MyName)
        Num = Num + 1
        With Workbooks(1).ActiveSheet
        .Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
        For G = 1 To Sheets.Count
        Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
        Next
        WbN = WbN & Chr(13) & Wb.Name
        Wb.Close False
        End With
    End If
    MyName = Dir
    Loop
    Range("B1").Select
    Application.ScreenUpdating = True
    MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub

2. Merge multiple files into separate sheets

Note: All files must be in the same folder. The code will use each file’s name as the sheet name. Since Excel sheet names can’t exceed 31 characters, make sure to check file name lengths beforehand.

Sub 合并多个文件到多个工作表()
    Dim Wk As Workbook, Sht As Worksheet, n As Integer, MyPath, MyName
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    n = 1
    MyPath = ThisWorkbook.Path & "\"  
    MyName = Dir(MyPath & "\" & "*.xlsx") 
    Do While MyName <> ""   
    If MyName <> ThisWorkbook.Name Then
        Set Wk = Workbooks.Open(MyPath & "\" & MyName)
        Wk.Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 
        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Mid(MyName, 1, Len(MyName) - 4)
        'For Each Sht In Wk.Sheets
        'Sht.Name = Format(n, "000″)
        'n = n + 1
        'Next
        Wk.Close False
    End If
    MyName = Dir
    Loop
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    MsgBox "合并完毕！", vbInformation, "提示"
End Sub

3. Merge multiple sheets within the same file

Sub UnionSheets()
    Application.ScreenUpdating = False
    For i = 1 To Sheets.Count
       If Sheets(i).Name <> ActiveSheet.Name Then
           X = Range("A65536").End(xlUp).Row + 1   '获取当前sheet中已有的行数，从+1行开始
           Sheets(i).UsedRange.Copy Cells(X, 1)    '往当前sheet中的Cells(X, 1)开始复制数据
       End If
    Next
    Range("A1").Select
    Application.ScreenUpdating = True
    MsgBox "合并完毕！", vbInformation, "报告"
End Sub

Original tutorial here.

Comments