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

我正在使用以下函数从工作簿中保存工作表并将其保存到单独的工作簿。但是，它正在保存公式，而我宁愿将这些值放在最终的工作簿中。我怎样才能修改这个，所以生成的工作簿不包含公式和公正值？将工作表中的值（不是公式）保存到新的工作簿中？

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的行错误？

来源

2013-07-29 mezamorphic

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

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

来源

2013-07-29 11:07:28 FrostbiteXIII

将特殊粘贴添加到我已有的粘贴中有多简单？我之前做过复制和粘贴的工作 - 我的困惑之处在于我上面的代码目前没有做任何粘贴。 – mezamorphic

我认为你必须粘贴每个单元格 - 也许尝试使用嵌套循环？ – FrostbiteXIII

.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

你需要添加一些错误处理代码，以处理那里有在复制工作表中没有公式的情况。（阵列式也可能需要考虑。）

来源

2013-07-29 12:31:28

复制的值的最简单的方法是做它在2个步骤：
复印片材，然后用它们的值

后更换式：

.Worksheets(1).Delete

在原始代码

，添加行：

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

的.value=.value告诉Excel来重新将每个值与当前正在显示的值进行比较，因此所有公式将被替换为其计算值

来源

2013-07-29 13:00:04 SeanC

AND ...肖恩打了我一分钟到“UsedRange”！ ;） – FrostbiteXIII

没有必要提取地址，只需要'.Worksheets（.Worksheets.Count）.UsedRange.Value = .Worksheets（.Worksheets.Count）.UsedRange.Value' –

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

回答

相关问题