利用VBA实现多个Excel工作簿快速合并方法

工具/原料

 

•  Excel
•  VBA

方法/步骤

 

1. 1

    为了便于演示，我在同一个文件夹下随便建了几个Excel文件（当然我们也可以合并不同文件夹下的Excel文档），随机输了一些内容。另外建了一个名称为汇总文件的xls文件，这是我们准备写入代码并汇总数据的Excel空文件。

   
2. 2

   双击打开汇总文件.xls(当然我们也可以随便新建一个excel文档）,按ALT+F11打开VBE编辑器,新建一个模块,粘贴如下代码：

   Option Explicit

   Sub mergeonexls() '合并多工作簿中指定工作表

   On Error Resume Next

   Dim x As Variant, x1 As Variant, w As Workbook, wsh As Worksheet

   Dim t As Workbook, ts As Worksheet, l As Integer, h As Long

   Application.ScreenUpdating = False

   Application.DisplayAlerts = False

   x = Application.GetOpenFilename(FileFilter:="Excel文件 (*.xls; *.xlsx),*.xls; *.xlsx,所有文件(*.*),*.*", _

          Title:="Excel选择", MultiSelect:=True)

   Set t = ThisWorkbook

   Set ts = t.Sheets(1) '指定合并到的工作表，这里是第一张工作表

   l = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Column

   For Each x1 In x

   If x1 <> False Then

    Set w = Workbooks.Open(x1)

    Set wsh = w.Sheets(1) '指定所需合并工作表，这里是第一张工作表

    h = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Row

    If l = 1 And h = 1 And ts.Cells(1, 1) = "" Then

    wsh.UsedRange.Copy ts.Cells(1, 1)

    Else

    wsh.UsedRange.Copy ts.Cells(h + 1, 1)

    End If

    w.Close

   End If

   Next

   Application.ScreenUpdating = True

   Application.DisplayAlerts = True

   End Sub

   Sub mergeeveryonexls() '将多个工作簿下的工作表依次对应合并到本工作簿下的工作表，即第一张工作表对应合并到第一张，第二张对应合并到第二张……

   On Error Resume Next

   Dim x As Variant, x1 As Variant, w As Workbook, wsh As Worksheet

   Dim t As Workbook, ts As Worksheet, i As Integer, l As Integer, h As Long

   Application.ScreenUpdating = False

   Application.DisplayAlerts = False

   x = Application.GetOpenFilename(FileFilter:="Excel文件 (*.xls; *.xlsx),*.xls; *.xlsx,所有文件(*.*),*.*", _

          Title:="Excel选择", MultiSelect:=True)

   Set t = ThisWorkbook

   For Each x1 In x

   If x1 <> False Then

    Set w = Workbooks.Open(x1)

    For i = 1 To w.Sheets.Count

   If i > t.Sheets.Count Then t.Sheets.Add After:=t.Sheets(t.Sheets.Count)

    Set ts = t.Sheets(i)

    Set wsh = w.Sheets(i)

    l = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Column

    h = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Row

    If l = 1 And h = 1 And ts.Cells(1, 1) = "" Then

    wsh.UsedRange.Copy ts.Cells(1, 1)

    Else

    wsh.UsedRange.Copy ts.Cells(h + 1, 1)

    End If

    Next

    w.Close

   End If

   Next

   Application.ScreenUpdating = True

   Application.DisplayAlerts = True

   End Sub

    

   
3. 3

    单击菜单：工具-宏-宏（或者ALT+F8），打开宏对话框。

   
4. 4

   我们先来看看多个Excel工作簿指定工作表快速合并（我这里是指定合并第一张工作表，可自行到代码注释部位更改指定的表）的实现：在宏对话框中运行名称为：mergeonexls的宏，在弹出的Excel选择对话框中选中book1-book3（当然你也可以随便选择一些需要合并的Excel文件），打开。

   
5. 5

    查看下效果，如下图：

   
6. 6

    利用和上面相同的操作运行mergeeveryonexls宏，在弹出的Excel选择对话框中选中book1-book3，打开。查看所有工作表依次合并的效果，可见不仅把book1-book3中sheet1-sheet3中的内容汇总，因为book1中还含有sheet4工作表，所以还新插入了一个工作表sheet4，汇总了book1中sheet4中的内容，如下图。

   

   
7. 7

    演示文档可至http://pan.baidu.com/s/1eQHgsXc处下载。