Excel VBA 从现有代码中保存多个工作表

Posted 2023-05-07

【中文标题】Excel VBA 从现有代码中保存多个工作表

【英文标题】：Excel VBA saving multiple worksheets from existing code

【发布时间】：2018-07-12 20:09:32

【问题描述】：

在发帖之前我找不到具体的答案。

有人可以帮助我在 Excel 中调整我现有的 VBA 代码，使我能够复制 2 个工作表，而不仅仅是 1 个工作表吗？我收到一个错误。它适用于 1 张纸，但不适用于 2 张纸。我已将失败的代码以粗体显示。

Sub Export()

Dim FlSv As Variant
Dim MyFile As String
Dim MyTemplate As String
Dim sh As Worksheet
Dim wbNew As Workbook

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

这是失败的地方：

Set sh = ActiveWorkbook.Sheets("Sheet 1", "Sheet 2")
    sh.Copy

    Set wbNew = ActiveWorkbook

    MyFile = Replace("Consolidated", ".xlsm", "")

    FlSv = Application.GetSaveAsFilename(MyFile, fileFilter:="Excel Files (*.xlsx), *.xlsx)", Title:="Enter your file name")

    wbNew.SaveAs FlSv, FileFormat:=51
    wbNew.Close

    For Each s In ActiveWorkbook.Sheets
        If s.Name Like "*Sheet 1*" Then
            Application.DisplayAlerts = False
            s.Delete
            Application.DisplayAlerts = True
        End If
    Next s

  For Each s In ActiveWorkbook.Sheets
        If s.Name Like "*Sheet 2*" Then
            Application.DisplayAlerts = False
            s.Delete
            Application.DisplayAlerts = True
        End If
    Next s

    End Sub

也试过了：

Sub Export()

Dim FlSv As Variant
Dim MyFile As String
Dim MyTemplate As String
Dim sh As Worksheet
Dim wbNew As Workbook

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

'Set sh = ActiveWorkbook.Sheets("Overrun")
'sh.Copy
'Set wbNew = ActiveWorkbook

ActiveWorkbook.workheets(Array("Sheet 1", "Sheet 2")).Copy
'there is a new activeworkbook with two worksheets
Set wbNew = ActiveWorkbook

MyFile = Replace("Consolidated", ".xlsm", "")

FlSv = Application.GetSaveAsFilename(MyFile, fileFilter:="Excel Files (*.xlsx), *.xlsx)", Title:="Enter your file name")

wbNew.SaveAs FlSv, FileFormat:=51
wbNew.Close

For Each s In ActiveWorkbook.Sheets
    If s.Name Like "*Overrun*" Then
        Application.DisplayAlerts = False
        s.Delete
        Application.DisplayAlerts = True
    End If
Next s

End Sub
Sub all()

End Sub

【参考方案1】：

使用工作表名称数组。

dim wb as workbook

ActiveWorkbook.sheets(array("Sheet 1", "Sheet 2")).copy
'there is a new activeworkbook with two worksheets
set wb = ActiveWorkbook

【讨论】：

Activeworkbook 代码出错：对象不支持此属性方法

我今天拼写不好。

错误来自 ActiveWorkbook.worksheets(array("Sheet 1", "Sheet 2")).copy 行

只要我提供有效的工作表名称，该代码就对我有效。以上来自您问题中的原始代码。

不确定是什么问题。我正在尝试我已经编辑了上面的内容以显示我的完整代码。