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

2025-10-24 07:31:07

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

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

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

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

3、 单击菜单:工具-宏-宏(或者ALT+F8),打开宏对话框。

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

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

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

5、 查看下效果,如下图:

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

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

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

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

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

声明:本网站引用、摘录或转载内容仅供网站访问者交流或参考,不代表本站立场,如存在版权或非法内容,请联系站长删除,联系邮箱:site.kefu@qq.com。
猜你喜欢