如何把文件夹中多个工作簿中的多个工作表合并到一张工作表中

黑色羽毛 · 发表于 2014-6-22 16:29

看看学习下

cqcbc · 发表于 2014-6-23 07:07

这汇总的代码很实用，会经常使用，学习了。

ws123123 · 发表于 2014-7-19 09:52

zhaogang1960 发表于 2013-9-18 17:03
假设工作簿打开密码是"abc"：

请教怎么把指定路径可以用对话框弹出，贴入路径？？谢谢

BeMin · 发表于 2014-8-5 22:08

zhaogang1960 发表于 2013-9-17 17:50
请看附件

语句已经按我的自己需求修改了，但有几个问题要赵老师指导一下：
1、我的表格有保护工作表，脚本此时不能运行
2、排除表“汇总”不进行批量复制
3、表里面包含公式导致多表时占用很多资源，能否只复制数值和单元格格式

zhaogang1960 · 发表于 2014-8-5 23:05

BeMin 发表于 2014-8-5 22:08
语句已经按我的自己需求修改了，但有几个问题要赵老师指导一下：
1、我的表格有保护工作表，脚本此时不能 ...

Sub Macro1()
Dim MyPath$, MyName$, sh As Worksheet, sht As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlManual
Set sh = ActiveSheet
MyPath = ThisWorkbook.Path & ""
MyName = Dir(MyPath & "*.xls")
[a1].CurrentRegion.Offset(7).Clear
Do While MyName <> ""
If MyName <> ThisWorkbook.Name Then
With GetObject(MyPath & MyName)
For Each sht In .Sheets
If sht.Name <> "汇总" Then
sht.Unprotect
If sht.[a1].CurrentRegion.Rows.Count > 2 Then
lr = sh.[a1].CurrentRegion.Rows.Count + 1
r = sht.[a1].CurrentRegion.Rows.Count - 7
sh.Cells(lr, 1).Resize(r) = MyName
sh.Cells(lr, 2).Resize(r) = sht.Name
sht.[a1].CurrentRegion.Offset(7).Copy sh.Cells(lr, 3)
End If
End If
Next
.Close False
End With
End If
MyName = Dir
Loop
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
MsgBox "ok"
End Sub

复制代码

cqcbc · 发表于 2014-9-20 11:04

本帖最后由 cqcbc 于 2014-9-20 12:26 编辑

zhaogang1960 发表于 2013-9-17 23:10
请看附件

赵老师：你好！本例子中，我只修改了01号-小孙、小张、小李.xls，运行代码出错，请帮忙修改一下。

excel_芳婷 · 发表于 2015-10-27 10:57

zhaogang1960 发表于 2013-9-17 23:10
请看附件

效果xls就是我的需求，文件夹下的工作簿合并到效果xls下的sheet，但一定要保持原格式列宽。在线急等。

zhaogang1960 · 发表于 2015-10-27 15:15

excel_芳婷发表于 2015-10-27 10:57
效果xls就是我的需求，文件夹下的工作簿合并到效果xls下的sheet，但一定要保持原格式列宽。在线急等。

...

删除原来所有表，复制新表：
Sub Macro1()
Dim MyPath$, MyName$, wb As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveSheet.Name = "temp"
For Each sh In Worksheets
      If sh.Name <> ActiveSheet.Name Then sh.Delete
Next
MyPath = ThisWorkbook.Path & "\"
MyName = Dir(MyPath & "*.xlsx")
With ThisWorkbook.Worksheets
      Do While MyName <> ""
         Set wb = GetObject(MyPath & MyName)
         wb.Worksheets(1).Copy After:=.Item(.Count)
         wb.Close False
         MyName = Dir
      Loop
End With
Worksheets("temp").Delete
Application.ScreenUpdating = True
End Sub

ladeng87 · 发表于 2015-12-9 14:22

zhaogang1960老师：
如果想要把各个xlsx文件合并，去除第一行标题，从第二行开始保留，该怎么写呢？谢谢。1，2，3，4文件合并后效果如“合并后.xlxs”

nmcfbgttyl · 发表于 2015-12-31 22:19

太好地，值得学习

		自动登录	找回密码
密码			免费注册

[已解决] 如何把文件夹中多个工作簿中的多个工作表合并到一张工作表中

评分

评分