Excel 创建工作簿并仅复制具有值的工作表

我在这一行得到一个错误

destWB.SaveAs path&fname

-它说我不能使用“.xlsm”扩展名

此外，我希望将工作表复制到新工作簿中，但只保留值和原始格式

---

我的代码错误地复制了所有公式。我不想以任何方式破坏原始工作簿

您可以任意添加启用宏的工作簿文件扩展名（例如xlsm），但使用默认的文件格式参数（可在Excel选项中找到）► 拯救► 以以下格式保存文件：。事实上，最好完全不使用.xlsm并指定所需的文件格式。如果选择正确的格式，Excel将添加.xlsm。有关可用“另存为”文件类型的完整列表，请参阅

如果要将公式还原为其值，只需复制工作表，然后使用

.Cells=.Cells.Value

Sub values_dump()
Dim sourceWB As Workbook
Dim destWB As Workbook
Dim ws As Worksheet
Dim path As String
Dim fname As String

Application.ScreenUpdating = False

path = ThisWorkbook.path & "\_bck\"
fname = "values_" & Format(Now, "dd_mmm_yy_hh_mm_ss") & ".xlsm"

Set sourceWB = ThisWorkbook

Set destWB = Workbooks.Add
destWB.SaveAs path & fname

For Each ws In sourceWB.Worksheets

Workbooks(sourceWB).Sheets(ws).Copy after:=Workbooks(destWB).Sheets(1)

Next ws

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

---

当您将工作簿类型var设置为a时，您可以直接使用该var。您似乎是在使用它。和工作表也是如此。

谢谢，但我需要修改此设置，因为我在.Cells=.Cells.Value上的内存不足错误-如果我省略此语句，则不会出现任何问题：）我修改了代码，将公式一次还原一列，并在添加工作表之间保存工作簿。如果这将特别大，您可能还需要将.SaveAs更改为.xlsb二进制工作簿（

FileFormat:=xlExcel12

）。好的，我同意。。。最后一个问题是图纸的原始顺序无法保持。。也许我们可以以相反的顺序开始复制？不，这是因为您总是在=destWB.Sheets（1）之后添加复制的工作表。它们应该在=destWB.Sheets（destWB.Sheets.Count）之后添加

，然后再使用destWB.Sheets（destWB.Sheets.Count）对
进行一次调整。你能做那些MOD吗？有一个错误，在自动过滤激活的地方复制工作表。我们是否有可能删除过滤器，然后在复制的工作表上重新应用它？
Sub values_dump()
    Dim sourceWB As Workbook
    Dim destWB As Workbook
    Dim ws As Worksheet
    Dim path As String
    Dim fname As String
    Dim c As long

    Application.ScreenUpdating = False

    path = ThisWorkbook.path & "\_bck\"
    fname = "values_" & Format(Now, "dd_mmm_yy_hh_mm_ss") & ".xlsm"

    Set sourceWB = ThisWorkbook
    Set destWB = Workbooks.Add
    destWB.SaveAs Filename:=path & fname, FileFormat:=xlOpenXMLWorkbookMacroEnabled 'Open XML Workbook Macro Enabled (52)

    For Each ws In sourceWB.Worksheets

        if ws.autofiltermode then ws.autofiltermode = false
        ws.Copy after:=destWB.Sheets(1)
        With destWB.Sheets(2).usedrange
            for c = 1 to .columns.count
                .columns(c).Cells = .columns(c).Cells.Value
            next c
        End With
        destWB.save

    Next ws

    Application.ScreenUpdating = True
End Sub