Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2560|回复: 4

[已解决]求助!如何快速将多个excel里工作表转移到一个excel文件里 谢谢!

[复制链接]
发表于 2016-4-3 21:01 | 显示全部楼层 |阅读模式
如题 如何快速将多个excel里工作表转移到一个excel文件里

我有好几十个excel文件 每个里面都只有一个工作表 求助高手 怎样能快速把它们转移到一个excel文件里面呢?
(注:合并到一个文件里以后也是单独的一个工作表 而不是向网上其他人说的 合并成一个工作表)
最佳答案
2016-4-3 22:53
  1. Sub Macro1()
  2. On Error Resume Next
  3. mypath = ThisWorkbook.Path & ""
  4. Set Shts = ThisWorkbook.Sheets
  5. Application.ScreenUpdating = False
  6. Application.DisplayAlerts = False
  7. For Each sh In Sheets
  8.     If sh.Name <> "界面" Then sh.Delete
  9. Next
  10. wj = Dir(mypath & "*.xls*")
  11. Do While wj <> ""
  12.     If wj <> ThisWorkbook.Name Then
  13.         With Workbooks.Open(mypath & wj)
  14.             bm = .Sheets(1).Name
  15.             .Sheets(1).Copy after:=Shts(Shts.Count)
  16.             .Close 0
  17.         End With
  18.         ActiveSheet.Name = bm
  19.     End If
  20. wj = Dir
  21. Loop
  22. Application.DisplayAlerts = True
  23. Application.ScreenUpdating = True
  24. End Sub
复制代码
发表于 2016-4-3 22:42 | 显示全部楼层
建议:
1)上传2个要转移的工作簿
2)上传1个手动合并好的工作簿
3)在[size=1em]『Excel VBA程序开发』中,重新发帖。

回复

使用道具 举报

发表于 2016-4-3 22:53 | 显示全部楼层    本楼为最佳答案   
  1. Sub Macro1()
  2. On Error Resume Next
  3. mypath = ThisWorkbook.Path & ""
  4. Set Shts = ThisWorkbook.Sheets
  5. Application.ScreenUpdating = False
  6. Application.DisplayAlerts = False
  7. For Each sh In Sheets
  8.     If sh.Name <> "界面" Then sh.Delete
  9. Next
  10. wj = Dir(mypath & "*.xls*")
  11. Do While wj <> ""
  12.     If wj <> ThisWorkbook.Name Then
  13.         With Workbooks.Open(mypath & wj)
  14.             bm = .Sheets(1).Name
  15.             .Sheets(1).Copy after:=Shts(Shts.Count)
  16.             .Close 0
  17.         End With
  18.         ActiveSheet.Name = bm
  19.     End If
  20. wj = Dir
  21. Loop
  22. Application.DisplayAlerts = True
  23. Application.ScreenUpdating = True
  24. End Sub
复制代码

新建文件夹.zip

12.24 KB, 下载次数: 16

回复

使用道具 举报

发表于 2016-4-4 07:12 | 显示全部楼层
强大的vba,学习了。
回复

使用道具 举报

 楼主| 发表于 2016-4-4 10:35 | 显示全部楼层
dsmch 发表于 2016-4-3 22:53

!太棒了!~ 完美解决了我的问题 谢谢你!
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-28 17:50 , Processed in 1.085851 second(s), 12 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表