vba 将值（不是公式）从工作表保存到新工作簿？

Save values (not formulae) from a sheet to a new workbook?

提问by mezamorphic

I am using the following function to save a worksheet from a workbook and save it to a separate workbook. However, it is saving the formulas, whereas I would rather just the values end up in the final workbook. How can I modify this so the resultant workbook doesn't contain formulae and just values?

我正在使用以下函数从工作簿中保存工作表并将其保存到单独的工作簿中。但是，它正在保存公式，而我宁愿将这些值放在最终工作簿中。我该如何修改它，以便生成的工作簿不包含公式而只包含值？

Sub Sheet_SaveAs(FilePath As String, SheetToSave As Worksheet)
    Dim wb As Workbook

    Set wb = Workbooks.Add(xlWBATWorksheet)
    With wb
        SheetToSave.Copy After:=.Worksheets(.Worksheets.Count)
        Application.DisplayAlerts = False
        .Worksheets(1).Delete
        Application.DisplayAlerts = True
        .SaveAs FilePath
        .Close False
    End With

End Sub

Using the link kindly provided I tried this, but to no avail:

使用友好提供的链接我试过这个，但无济于事：

Sub Sheet_SaveAs(FilePath As String, SheetToSave As Worksheet)
    Dim wb As Workbook

    Set wb = Workbooks.Add(xlWBATWorksheet)
    With wb
        SheetToSave.Copy After:=.Worksheets(.Worksheets.Count)
        Application.DisplayAlerts = False
        .Worksheets(1).Delete
        .Worksheets(1).Copy
        .Worksheets(1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.DisplayAlerts = True
        .SaveAs FilePath
        .Close False
    End With

End Sub

but I get an error on the pastespecial line??

但是我在 pastespecial 行出现错误？？

回答by Andy G

.Worksheets(1).Copy

This copies the sheet itself and does not relate to PasteSpecial. You could use:

这会复制工作表本身并且与PasteSpecial. 你可以使用：

.Worksheets(1).UsedRange.Copy

or similar. For example, Worksheets(1).Cells.Copy.

或类似。例如，Worksheets(1).Cells.Copy。

I assume it should be Worksheets(.Worksheets.Count)though.

我认为它应该Worksheets(.Worksheets.Count)虽然。

In the following I am using SpecialCellsto identify only the formulas in the worksheet, and setting rng.Value = rng.Valueto convert these to the results of the formulas.

在下文中，我SpecialCells仅用于识别工作表中的公式，并设置rng.Value = rng.Value将这些公式转换为公式的结果。

Sub Sheet_SaveAs(FilePath As String, SheetToSave As Worksheet)
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rngFormulas As Range, rng As Range

    Set wb = Workbooks.Add(xlWBATWorksheet)
    With wb
        SheetToSave.Copy After:=.Worksheets(.Worksheets.Count)
        Set ws = .Worksheets(.Worksheets.Count)
        Application.DisplayAlerts = False
        .Worksheets(1).Delete
        Application.DisplayAlerts = True

        With ws
            Set rngFormulas = ws.Cells.SpecialCells(xlCellTypeFormulas)
            For Each rng In rngFormulas
                rng.Value = rng.Value
            Next rng
        End With

        .SaveAs FilePath
        .Close False
    End With
End Sub

You will need to add some error handling code, to handle the case where there are no formulas in the copied worksheet. (Array formulas may also need to be accounted for.)

您将需要添加一些错误处理代码，以处理复制的工作表中没有公式的情况。（可能还需要考虑数组公式。）

回答by SeanC

The easiest way to copy the values is to do it in 2 steps:
Copy the sheet, then replace the formulas with their values

复制值的最简单方法是分两步完成：
复制工作表，然后用它们的值替换公式

After:

后：

.Worksheets(1).Delete

in your original code, add the lines:

在您的原始代码中，添加以下行：

With Range(Worksheets(.Worksheets.Count).UsedRange.Address)
    .Value = .Value
End With

The .value=.valueis telling excel to replace every value with the value that is currently being displayed, so all formulas will be replaced with their calculated value

该.value=.value告诉Excel来替换当前正在显示的值的每一个值，所以所有公式将其计算出的值替换

回答by FrostbiteXIII

Sorry, answer was starting to look a complete mess, so deleted it and started again. I've written this - it appears to work fine when I tested it - you just need an extra line to save any resulting spreadsheet. :)

对不起，答案开始看起来一团糟，所以删除它并重新开始。我已经写了这个 - 当我测试它时它似乎工作正常 - 你只需要额外的一行来保存任何生成的电子表格。:)

For Each Cell In ActiveSheet.UsedRange.Cells
    Cell.Copy
    Cell.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next