求助如何修改一键生成导出指定多个工作表另存为到一个新工作簿。谢谢

lsc900707

qinhuan66 发表于 2019-6-5 17:06
不好意思，可能表达不是很清楚，我意思是一个工作簿有很多表，我需要导出指定几个表出来形成一个新的工作 ...

命名呢？以第一个工作表的[c2]作为新工作簿名？

qinhuan66

lsc900707 发表于 2019-6-5 17:10
命名呢？以第一个工作表的[c2]作为新工作簿名？

老师，是的就以表一C2为名

lsc900707

qinhuan66 发表于 2019-6-5 17:13
老师，是的就以表一C2为名

1. Sub 导出新工作簿()
   
2.     Dim shp As Shape
   
3.     Dim fileSaveName
   
4.     fileSaveName = Application.GetSaveAsFilename(Range("$C2"), fileFilter:="Microsoft Excel Files (*.xls),*.xls")
   
5.     If fileSaveName = False Then Exit Sub
   
6.     Sheets(Array("表一", "表二", "表三")).Copy
   
7.     For Each sht In Sheets
   
8.         For Each shp In sht.Shapes
   
9.             shp.Delete
   
10.         Next
    
11.     Next
    
12.     ActiveWorkbook.SaveAs fileSaveName
    
13.     ActiveWorkbook.Close
    
14.     MsgBox "呵呵！另保存成功！"
    
15. End Sub
    

复制代码

qinhuan66

lsc900707 发表于 2019-6-5 17:25

版主，靓货哦。谢谢

lsc900707

qinhuan66 发表于 2019-6-5 17:31
版主，靓货哦。谢谢

上一个帖子也用数组帮你解决了，请测试。

qinhuan66

lsc900707 发表于 2019-6-5 17:41
上一个帖子也用数组帮你解决了，请测试。

版主，经测试，真的已清除按纽和宏代码，但还有一个额外的公式没清除，现打开总是提示有外链接。能否加条代码一并清除。谢谢

lsc900707

qinhuan66 发表于 2019-6-5 17:53
版主，经测试，真的已清除按纽和宏代码，但还有一个额外的公式没清除，现打开总是提示有外链接。能否加条 ...

那不是公式，是版本的问题。你用的office是什么版本的？

qinhuan66

lsc900707 发表于 2019-6-5 17:59
那不是公式，是版本的问题。你用的office是什么版本的？

我用的是2016版，我测试发现这些表如果引用有公式，导去时不会变拷贝为数值，还是公式，如果拷贝离开源文件，即为错误值。谢谢

lsc900707

qinhuan66 发表于 2019-6-5 18:44
我用的是2016版，我测试发现这些表如果引用有公式，导去时不会变拷贝为数值，还是公式，如果拷贝离开源文 ...

原来你的附件与你的实际文件都不一样的呀。稍加修改就是。

1. Sub 导出新工作簿()
   
2.     Dim shp As Shape
   
3.     Dim fileSaveName
   
4.     fileSaveName = Application.GetSaveAsFilename(Range("$C2"), fileFilter:="Microsoft Excel Files (*.xls),*.xls")
   
5.     If fileSaveName = False Then Exit Sub
   
6.     Sheets(Array("表一", "表二", "表三")).Copy
   
7.     For Each sht In Sheets
   
8.         With sht.UsedRange
   
9.             .Value = .Value
   
10.         End With
    
11.         For Each shp In sht.Shapes
    
12.             shp.Delete
    
13.         Next
    
14.     Next
    
15.     ActiveWorkbook.SaveAs fileSaveName
    
16.     ActiveWorkbook.Close
    
17.     MsgBox "呵呵！另保存成功！"
    
18. End Sub

复制代码

qinhuan66

lsc900707 发表于 2019-6-5 20:02
原来你的附件与你的实际文件都不一样的呀。稍加修改就是。

好的，辛苦版主了