Question

VBA以下代码怎么修改可以识别打开EXCEL表中指定某几个EXCEL表另存为，通过一个命令按钮，怎么修改

Private Sub CommandButton1_Click()
If Dir("E:\备份", vbDirectory) = "" Then '查检E盘中有没有“备份”文件夹
MkDir "E:\备份" '没有就建一个“备份”文件夹
End If
Application.DisplayAlerts = False '取消提示
'ThisWorkbook.SaveAs "E:\备份\" & ThisWorkbook.Name '备份文件
ThisWorkbook.SaveAs "E:\备份\上海出票政策.xls"
Application.DisplayAlerts = True '恢复提示
End Sub
举个例子：打开的EXCEL表有a，b，c，d四个表，a表是存储窗体代码的，想要的效果就是点击a表里面的按钮实现将b，c另存至E:\备份\（另存名自己设定）就是将打开的几个EXCEL表中找出要另存的表，然后另存就OK了，谢谢大家了
Private Sub CommandButton1_Click()
If Dir("E:\备份", vbDirectory) = "" Then '查检E盘中有没有“备份”文件夹
MkDir "E:\备份" '没有就建一个“备份”文件夹
End If
Application.DisplayAlerts = False '取消提示
ThisWorkbook.SaveAs "E:\备份\上海出票政策.xls"
Application.DisplayAlerts = True '恢复提示
End Sub
这是我的源码，应该怎么改，是将指定的工作簿拷另存为新的工作簿

Answer 1

Private Sub CommandButton1_Click()
On Error Resume Next
If Dir("E:\备份", vbDirectory) = "" Then '查检E盘中有没有“备份”文件夹
MkDir "E:\备份" '没有就建一个“备份”文件夹
End If
On Error GoTo 0
Application.DisplayAlerts = False '取消提示
Dim myname As String
myname = Application.InputBox("请输入文件名", "输入", ThisWorkbook.Name)
If myname = "" Then
ThisWorkbook.SaveAs "E:\备份\" & ThisWorkbook.Name & "\xls" '备份文件
ESLE: ThisWorkbook.SaveAs "E:\备份\" & myname & "\xls"
End If
Application.DisplayAlerts = True '恢复提示
End Sub

 你首先未进行错误忽略处理，只要有错误就直接弹掉了 ，要先防错才能适用

Dir("E:\备份", vbDirectory) = ""

你试试是不是你想要的吧，说实话没完全理解你是想要什么 ，是要把单个工作表都另存为一个单独的工作薄么？还是怎样呢，假如是这样，用SHEETS.COPY方法，未打开的话首先用OPEN打开。

追问

我需要的是工作簿另存为工作簿，Book1另存为Book2

追答

Private Sub CommandButton1_Click()
On Error Resume Next

If Dir("d:\备份", vbDirectory) = "" Then '查检E盘中有没有“备份”文件夹
MkDir "d:\备份" '没有就建一个“备份”文件夹
End If
On Error GoTo 0

  Application.DisplayAlerts = False '取消提示

   Dim myname As String
   myname = Application.InputBox("请输入文件名", "输入", ThisWorkbook.Name)
   If myname = "" Then myname = ThisWorkbook.Name
   ThisWorkbook.Sheets(Array("b", "c", "d")).Copy
Application.DisplayAlerts = true







End Sub

Answer 2

你需要把指定的表拷贝为新工作簿，然后另存为，对吧？下面的代码满足你的要求：

Private Sub CommandButton1_Click()
If Dir("E:\备份", vbDirectory) = "" Then '查检E盘中有没有“备份”文件夹
MkDir "E:\备份" '没有就建一个“备份”文件夹
End If
Application.DisplayAlerts = False '取消提示
ThisWorkbook..Sheets(Array("A","B","C")).Copy '这里拷贝A、B、C三个表，你修改可以实现拷贝其它表
ActiveWorkbook.SaveAs "E:\备份\上海出票政策.xls" '注意这里的ActiveWorkbook表示新考虑的工作簿
Application.DisplayAlerts = True '恢复提示
End Sub

追问

师傅啊，这个不行啊，我是将指定的工作簿拷另存为新的工作簿

追答

你说清楚点，究竟是工作簿还是工作表？？？一个工作簿就是一个EXCEL文件，例如Book1，一个工作簿里面有多个工作表，例如Sheet1、Sheet2、……

“举个例子：打开的EXCEL表有a，b，c，d四个表”，表里面的表，什么意思？

你原始程序中是ThisWorkbook.SaveAs表示把写代码的这个工作簿另存为，如果要把其它工作簿另存为可以这样写：

Books("xxx.xls").SaveAs