将表单中的值(不是公式)保存到新的工作簿?

我正在使用以下函数从工作簿保存工作表并将其保存到一个单独的工作簿。 但是,这是保存公式,而我宁愿只是最后的工作簿中的值。 我怎样才能修改这个,所以生成的工作簿不包含公式和值?

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 

使用友善提供的链接,我试过这个,但无济于事:

 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 

但是我在pastespecial行上遇到错误?

 .Worksheets(1).Copy 

这复制工作表本身并不涉及PasteSpecial 。 你可以使用:

 .Worksheets(1).UsedRange.Copy 

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

我认为它应该是Worksheets(.Worksheets.Count)但。

在下面我使用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 

您将需要添加一些error handling代码,以处理在复制的工作表中没有公式的情况。 (数组公式也可能需要考虑。)

复制值最简单的方法是分两步进行:
复制工作表,然后用它们的值replace公式

后:

 .Worksheets(1).Delete 

在您的原始代码中,添加行:

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

.value=.value告诉excel用当前显示的值replace每个值,所以所有的公式都会被他们的计算值replace

对不起,答案开始看起来一塌糊涂,所以删除它,然后重新开始。 我写了这个 – 它testing它似乎工作正常 – 你只需要一个额外的行来保存任何结果电子表格。 🙂

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