多个excel工作簿合并 工作表合并到一张表

2025-01-1006:19:59常识分享0

回顾旧时功能,学员再次求援

时隔一年,曾经发布的一篇关于工作簿合并的教程被我们的学员重新提起。该功能旨在简化工作流,帮助用户将多个工作簿轻松合并成多个工作表。值得一提的是,尽管功能已能实现一键合并的操作,但工作表的命名始终没有自动改名为原工作簿的名称。

实例教学:以12个的工作簿为例

当我们面对一堆的工作簿文件时,如何快速有效地将它们整合在一起呢?以一个包含12个的工作簿为例,我们常常需要将文件夹内的所有工作簿统一合并到一个总的工作簿中。

操作效果简述

合并后的效果是这样的:每一个工作表的名称会采用原来对应工作簿的名称进行命名,而每个工作表内则会放置原来工作簿的内容。这样一来,我们可以通过简单的表格切换,快速查找到我们需要的信息。

实际操作指南

为了方便用户操作,我们将整个合并的模板放置在需要合并的实际文件夹内。用户只需打开这个模板,运行相应的程序,短短几秒钟内,就可以将所有指定的工作簿轻松合并过来。

程序代码详解

以下是一个简单的VBA程序代码示例,用于实现上述的合并功能:

```vba

Sub 合并工作簿()

Dim Wb As Workbook

Dim MyPath As String

Dim File As String

Dim Sh_n As String

Application.ScreenUpdating = False '关闭屏幕刷新以提升操作速度

MyPath = ThisWorkbook.Path & "\" '获取当前工作簿的路径

File = Dir(MyPath & ".xls") '开始遍历路径下所有Excel文件

Do While File "" '遍历每一个文件并进行操作

If File ThisWorkbook.Name Then '判断是否为当前工作簿,避免自身合并

Set Wb = Workbooks.Open(MyPath & File) '打开需要合并的工作簿

Sh_n = GetWorkbookName(Wb) '获取工作簿名称并反转得到新的工作表名

Wb.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) '复制第一个工作表到当前工作簿的末尾

ActiveSheet.Name = Sh_n '设置新工作表的名称

Wb.Close False '关闭已打开的工作簿并释放资源(不保存更改)

End If

File = Dir '继续寻找下一个需要合并的文件

Loop

Application.ScreenUpdating = True '重新开启屏幕刷新,完成操作

End Sub

Function GetWorkbookName(ByVal Wb As Workbook) As String

'此函数用于获取工作簿的名称作为新工作表的名称,具体实现方式根据实际情况编写。

End Function

```