同一文件下有xls xlsx 如何合并，请大神帮忙修改下代码

zyx_216 · 发表于 2018-7-19 09:52

文件夹下有两种格式的工作簿，永这个代码合并就少了xls方式，求大神给帮忙改下

Sub 工作薄间工作表合并()
Dim FileOpen
Dim X As Integer
Application.ScreenUpdating = False
FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel文件(*.xlsx),*.xlsx" , MultiSelect:=True, Title:="合并工作薄")
X = 1
While X <= UBound(FileOpen)
Workbooks.Open Filename:=FileOpen(X)
Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
X = X + 1
Wend
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
errhadler:
MsgBox Err.Description
End Sub

朱荣兴 · 发表于 2018-7-19 10:10

提示: 作者被禁止或删除内容自动屏蔽

lsc900707 · 发表于 2018-7-19 10:14

FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel文件(*.xlsx),*.xlsx" , MultiSelect:=True, Title:="合并工作薄")
修改成：
FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel文件(*.xl*),*.xl*" , MultiSelect:=True, Title:="合并工作薄")

opiona · 发表于 2018-7-19 10:18

http://club.excelhome.net/thread-1409141-1-1.html

zyx_216 · 发表于 2018-7-19 11:28

朱荣兴发表于 2018-7-19 10:10
FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel文件(*.xls*),*.xls*", MultiSelect ...

非常感谢

zyx_216 · 发表于 2018-7-19 11:29

lsc900707 发表于 2018-7-19 10:14
FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel文件(*.xlsx),*.xlsx" , MultiSelec ...

谢谢帮忙！！！

zyx_216 · 发表于 2018-7-19 11:32

opiona 发表于 2018-7-19 10:18
http://club.excelhome.net/thread-1409141-1-1.html

谢谢帮忙！！！

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

朱荣兴朱荣兴当前离线性别保密 UID 1318548 阅读权限 0 注册时间 2011-2-2 在线时间小时最后登录 1970-1-1 积分 19282 财富分享技术精华头像被屏蔽 TA的精华主题 TA的得分主题	发表于 2018-7-19 10:10 \| 显示全部楼层 [广告] ★会Excel,就能做支持PC、手机、Web、App、Windows、安卓、IOS、Linux信息一体化的各种管理系统 ★ 提示: 作者被禁止或删除内容自动屏蔽

	回复举报

[求助] 同一文件下有xls xlsx 如何合并，请大神帮忙修改下代码