以特定文件格式在新工作簿中保存多个工作表

Question

我试图在论坛上阅读一些相关的帖子，但却无法使代码工作或理解一些函数的语法。

我将尝试以清晰的方式描述我想要做的事情：

• 我有一个包含多个工作表的工作簿（Sheet1，Sheet2 ... Sheet 5），我想创建一个宏指定按钮，以另存为新工作簿仅包含工作表1，表2和表3

• 文件格式应为Microsoft Excel 97-2003工作表（.xls）

• 单击“已分配宏”按钮时，将弹出“另存为”对话框，允许用户选择目的地，也可以选择新文件名（预先指定的文件名可以是“textstring123”

• 保存工作簿后，应打开工作簿以供用户在旧工作簿最小化时进行检查

我正在使用Excel 2013，如果相关的话。

这个帖子可能看起来很粗糙，但我别无选择，只能向你寻求帮助，因为我在过去的一天半时间里一直在忽视这一点，如果没有这个，我的宏观项目的其余部分将成为浪费。提前感谢您的建议/建议/帮助。

如果需要任何其他细节或说明，请询问。

我添加了我已编写的代码行，但似乎无法正常工作。

Sub Macro6()
'
' Macro6 Macro
' Save as
''
Dim varResult As Variant
Sheets(Array("sheet1", "sheet2", "sheet3")).Copy
varResult = Application.GetSaveAsFilename(FileFilter:= _
             "Excel Files *.xls", FileFormat:=-57, Title:="Save File", _
            InitialFileName:=ActiveWorkbook.Path \ Textstring123.xls)
If varResult <> False Then
ActiveWorkbook.SaveAs Filename:=varResult, _
FileFormat:=xlWorkbookNormal

     Exit Sub
    End If

End Sub

Answer 1

这样就可以解决问题了，我对Filters有一个问题，所以我添加了一些错误处理！

Option Explicit

Sub Macro6()
'
' Macro6 Macro
' Save as
''
Dim tB As Excel.Workbook
Dim wB As Excel.Workbook
Dim ExportArray As Variant
Dim ShName As Variant
Dim ExportName As String

Dim varResult As Variant

Set tB = ThisWorkbook
ExportArray = Array("sheet1", "sheet2", "sheet3")

For Each ShName In ExportArray
    Debug.Print ShName
    tB.Sheets(ShName).Copy
    Set wB = ActiveWorkbook
    On Error Resume Next
        ExportName = Application.GetSaveAsFilename(tB.Path & "\Textstring123", "Excel Files *.xls", , "Save " & ShName)
        If Err.Number > 0 Then
            ExportName = Application.GetSaveAsFilename(tB.Path & "\Textstring123", , , "Save " & ShName)
        Else
            'No error, everything went well with filters
        End If
    On Error GoTo 0

    'String 8 and Boolean 11
    If VarType(ExportName) <> 8 Then
        Exit Sub
    Else
        wB.SaveAs Filename:=ExportName, FileFormat:=xlWorkbookNormal
    End If
    DoEvents
    wB.Close
Next ShName

End Sub