如何将当前目录下所有工作簿内含有指定字符的工作表复制到一个工作簿中？

作者：绿色风分类：时间：2022-08-17 浏览：102

楼主 omnw	Q:如何将当前目录下所有工作簿内含有指定字符的工作表复制到一个工作簿中？ A:可以通过如下代码来实现。通过遍历工作簿中的所有工作表，将符合条件的工作表复制到“合并”工作簿中，并按照“原工作簿名称_原工作表名称”的格式重新命名工作表。 Sub 按钮1_Click() Dim FileName As String, str As String Dim sh As Worksheet, bok As Workbook, sht As Worksheet Const ShName As String = "ONU" '工作表名称中包含的字符 Application.ScreenUpdating = False FileName = Dir(ThisWorkbook.Path & "\*.xlsx") '获取文件名称 Do If FileName <> ThisWorkbook.Name Then '如果文件名非本文件名称 Set bok = Workbooks.Open(ThisWorkbook.Path & "\" & FileName) '打开工作簿 For Each sh In bok.Worksheets '逐一遍历工作簿中的工作表 If sh.Name Like ShName Then '如果工作表名称中包含指定的字符串 sh.Copy before:=ThisWorkbook.Worksheets(1) '将此工作表复制到“汇总”工作簿中 str = bok.Name '当前工作簿的名称 If InStr(str, ".") Then str = Split(str, ".")(0) '如果文件名含有扩展名，则取消扩展名 ThisWorkbook.Worksheets(1).Name = str & "_" & sh.Name '重新命名工作表的名称为“工作簿_工作表”格式 End If Next bok.Close (False) '关闭已经打开的工作表 End If FileName = Dir() '获取下一个工作簿的名称 Loop While FileName <> "" Application.ScreenUpdating = True End Sub 复制工作表.rar 该帖已经同步到
2楼篮板球	感谢技术指点。
3楼篮板球	测试成功，非常感谢。
4楼 icenotcool

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表