博客
关于我
强烈建议你试试无所不能的chatGPT,快点击我
合并多个excel表格的VBA
阅读量:5935 次
发布时间:2019-06-19

本文共 1290 字,大约阅读时间需要 4 分钟。

编辑器加载中...如果表不算太多的话可以试试这种方法,打开总表(要粘贴的表),打开一个要复制的表,右击要复制的工作表标签,选择移动或复制工作表,建立副本,选择要移动到表(要粘贴的那总表)。这种方法对合并到同一个文件中还是可行的。 但你说的汇总到一张表里就不行了,可以试试用“=”建立链接(要用相对地址),但这种方法对表结构相同或类似的才可以,而且文件名和表名称要有规律。这样会很快汇总到一张表中,下面的活儿就是整理一下的工作了,要是要数据的话就把链接改成数据才可以,这种方法好在可以动态更新你的数据。 写代码也可以,但若是工作量很大的话可考虑! 新建一个工作表,命名后保存到和与合并的100个文件同一个文件文件夹,摁 alt + f11,双击工程资源管理器里面的sheet1(sheet1),在右侧的代码区粘贴如下代码。运行。等候一会就OK了。

 
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
&
"
\
"
&
"
*.xls
"
)
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(
"
A65536
"
).End(xlUp).Row
+
2
,
1
)
=
Left
(MyName,
Len
(MyName)
-
4
)
For
G
=
1
To
Sheets.Count
Wb.Sheets(G).UsedRange.Copy .Cells(.Range(
"
A65536
"
).End(xlUp).Row
+
1
,
1
)
Next
WbN
=
WbN
&
Chr
(
13
)
&
Wb.Name
Wb.Close
False
End
With
End
If
MyName
=
Dir
Loop
Range(
"
A1
"
).Select
Application.ScreenUpdating
=
True
MsgBox
"
共合并了
"
&
Num
&
"
个工作薄下的全部工作表。如下:
"
&
Chr
(
13
)
&
WbN, vbInformation,
"
提示
"
End Sub

转载于:https://www.cnblogs.com/wwan/archive/2011/04/30/2033300.html

你可能感兴趣的文章
netaddr模块
查看>>
python crawler - 抓取拉勾网职位信息
查看>>
MySQL启动参数(四) —— innodb相关设置
查看>>
我的友情链接
查看>>
六、CPU优化(4)NUMA架构
查看>>
如何形成高端战力
查看>>
Mysql简单操作
查看>>
为什么我不倾向于录用培训机构的学生
查看>>
linux常用命令--用户和组
查看>>
CentOS实现一段时间后Shell自动登出非活动用户
查看>>
shell中的shift操作
查看>>
「深入 Exchange 2013」12 传输架构Part2
查看>>
四、文本的基本操作
查看>>
服务器存储共享文件夹丢失数据恢复检测报告
查看>>
将网页保存为PDF的几种方法
查看>>
egret 微端接入微信登录(Android端)
查看>>
Spark bind on port 0. Attempting port 1 问题解决
查看>>
Android的Dalvik虚拟机
查看>>
git学习笔记
查看>>
Python matplotlib简介 Pyplot教程
查看>>