首页 > 行业资讯 > 如何将指定文件夹下所有工作簿的工作表移动到当前工作簿？

如何将指定文件夹下所有工作簿的工作表移动到当前工作簿？

时间：2021-12-11 来源： 浏览：

如何将指定文件夹下所有工作簿的工作表移动到当前工作簿？

原创 EH看见星光 Excel星球
Excel星球

AhaExcel

建议常用Excel的职场人关注，海量教程随学随用，随用随查。 主创：看见星光，微软全球最有价值专家、Excel图书作者、培训师。 内容：每日四文，一篇函数教程、一篇VBA教程、一个短视频小技巧、一篇杂文。

收录于话题
每天一篇Excel技术图文
微信公众号：Excel星球
N O .568-多表移动到当前工作簿

作者：看见星光
 微博：EXCELers / 知识星球：Excel

HI，大家好，我是星光。Excel会员群里有朋友提了个问题： 有一个文件夹，里面有很多工作簿，工作簿内又有很多工作表，现在需要将每张工作表移动到当前工作簿 ，有没有什么好的解法办法？——打个响指，当然是有的，文末提供了一个一键解决该问题的Excel模版，下载后单击命令按钮，稍等数秒，即可完成目标。

牵牵爪子，一起看个小视频，了解下模版运行过程和效果。

如需实现以上动画展示的功能，示例代码如下▼ 代码解析见注释 代码看不全可以左右拖动..▼

’公众号Excel星球-看见星光 Sub GetSheetsCopy() Dim strPath As String , strBookName As String , strKey As String Dim strShtName As String , k As Long , wb As Workbook Dim sht As Worksheet, shtActive As Worksheet On Error Resume Next With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then strPath = .SelectedItems( 1 ) Else : Exit Sub End With If Right(strPath, 1 ) <> "" Then strPath = strPath & "" strKey = InputBox( "请输入工作表名称所包含的关键词。" & vbCr _ & "关键词可以为空，如为空，则默认移动全部工作表" ) If StrPtr(strKey) = 0 Then Exit Sub Set shtActive = ActiveSheet ’当前工作表，代码运行完毕后，回到此表 With Application .ScreenUpdating = False .DisplayAlerts = False .AskToUpdateLinks = False .Calculation = xlManual End With strBookName = Dir(strPath & "*.xls*" ) Do While strBookName <> "" If strBookName = ThisWorkbook.Name Then MsgBox "注意：指定文件夹中存在和当前工作簿重名的工作簿！！" & vbCr & "该工作簿无法打开，工作表无法复制。" ’当出现重名工作簿时，提醒用户。 Else Set wb = Workbooks.Open(strPath & strBookName) For Each sht In wb.Worksheets If IsEmpty(sht.UsedRange) = False Then If InStr( 1 , sht.Name, strKey, vbTextCompare) Then ’工作表名称是否包含关键词，关键词不区分大小写 strShtName = Split(strBookName, ".xls" )( 0 ) & "-" & sht.Name ’复制来的工作表以"工作簿-工作表"形式起名。 ThisWorkbook.Sheets(strShtName).Delete ’如果已存在相关表名，则删除 sht.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) ’复制到代码所在工作簿 k = k + 1 ’复制Sht到代码所在工作簿所有工作表的后面，并累计个数 ActiveSheet.Name = strShtName ’工作表命名 End If End If Next wb.Close False ’关闭工作簿，不保存 End If strBookName = Dir ’下一个符合条件的文件 Loop shtActive. Select ’回到初始工作表 MsgBox "工作表收集完毕，共收集：" & k & "个" With Application .ScreenUpdating = True .DisplayAlerts = True .AskToUpdateLinks = True .Calculation = xlAutomatic End With End Sub
模版下载百度网盘▼
https://pan.baidu.com/s/1sggKu1uCSXc2oh0riI55nQ
提取码: ghe
需要系统学习Excel，却找不到优质教程？学习Excel的过程中遇到疑难问题，却找不到人及时作出解答？加入我的付费社群，和微软MVP全面精进Excel，学习+答疑都不再是问题……

加入我的Excel会员， 全面学习Excel
透视表 函数 图表 VBA PQ想学啥学啥

本文由公众号“Excel星球”首发。

点击 阅读原文 ，加入Excel会员社群！

版权：如无特殊注明，文章转载自网络，侵权请联系cnmhg168#163.com删除！文件均为网友上传，仅供研究和学习使用，务必24小时内删除。
相关推荐
热门信息