架构师_程序员

 找回密码
 注册[Register]

QQ登录

只需一步,快速开始

查看: 208|回复: 0

把多个Excel文件合并到一个Excel文件的多个工作表(Sheet)里

[复制链接]
跳转到指定楼层
楼主
发表于 2019-8-5 11:33:55
zu
实现的功能是把多个Excel文件的第一个工作表(Sheet)合并到一个Excel文件的多个工作表里,并且新工作表的名称等于原Excel文件的文件名。开发环境Excel2007,但是Excel2003应该也能用,Excel2000似乎不能用。代码如下:

'功能:把多个工作簿的第一个工作表合并到一个工作簿的多个工作表,新工作表的名称等于原工作簿的名称

新建的excel新表---书签sheet1--右击查看代码-复制代码进入---运行-选择需要合并的表--OK
  1. Sub Books2Sheets()

  2.     '定义对话框变量

  3.     Dim fd As FileDialog

  4.     Set fd = Application.FileDialog(msoFileDialogFilePicker)



  5.     '新建一个工作簿

  6.     Dim newwb As Workbook

  7.     Set newwb = Workbooks.Add



  8.     With fd

  9.         If .Show = -1 Then

  10.             '定义单个文件变量

  11.             Dim vrtSelectedItem As Variant



  12.             '定义循环变量

  13.             Dim i As Integer

  14.             i = 1



  15.             '开始文件检索

  16.             For Each vrtSelectedItem In .SelectedItems

  17.                 '打开被合并工作簿

  18.                 Dim tempwb As Workbook

  19.                 Set tempwb = Workbooks.Open(vrtSelectedItem)



  20.                 '复制工作表

  21.                 tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i)



  22.                 '把新工作簿的工作表名字改成被复制工作簿文件名,这儿应用于xls文件,即Excel97-2003的文件,如果是Excel2007,需要改成xlsx

  23.                 newwb.Worksheets(i).Name = VBA.Replace(tempwb.Name, ".xls", "")



  24.                 '关闭被合并工作簿

  25.                 tempwb.Close SaveChanges:=False



  26.                 i = i + 1

  27.             Next vrtSelectedItem

  28.         End If

  29.     End With



  30.     Set fd = Nothing

  31. End Sub
复制代码

表合并完成后再进行修改每一个sheet的名称,这个方法不能把每个excel表的表名还原到生成的sheet的表名里

注意:没有合并上去的表,在表中新增加一个sheet空表--按住表名称再进行复制移动过去到总表中





上一篇:懒熊 45天搞定英语发音(完结)
下一篇:精通Git(第二版简体中文),最清晰版本
帖子永久地址: 

架构师_程序员 - 论坛版权1、本主题所有言论和图片纯属会员个人意见,与本论坛立场无关
2、本站所有主题由该帖子作者发表,该帖子作者与架构师_程序员享有帖子相关版权
3、其他单位或个人使用、转载或引用本文时必须同时征得该帖子作者和架构师_程序员的同意
4、帖子作者须承担一切因本文发表而直接或间接导致的民事或刑事法律责任
5、本帖部分内容转载自其它媒体,但并不代表本站赞同其观点和对其真实性负责
6、如本帖侵犯到任何版权问题,请立即告知本站,本站将及时予与删除并致以最深的歉意
7、架构师_程序员管理员和版主有权不事先通知发贴者而删除本文

码农网,只发表在实践过程中,遇到的技术难题,不误导他人。
您需要登录后才可以回帖 登录 | 注册[Register]

本版积分规则

免责声明:
码农网所发布的一切软件、编程资料或者文章仅限用于学习和研究目的;不得将上述内容用于商业或者非法用途,否则,一切后果请用户自负。本站信息来自网络,版权争议与本站无关。您必须在下载后的24个小时之内,从您的电脑中彻底删除上述内容。如果您喜欢该程序,请支持正版软件,购买注册,得到更好的正版服务。如有侵权请邮件与我们联系处理。

Mail To:help@itsvse.com

QQ|Archiver|手机版|小黑屋|架构师 ( 鲁ICP备14021824号-2 )|网站地图

GMT+8, 2019-12-7 02:17

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

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