复制整个工作表并粘贴为值

我试图将活动工作表复制到一个新的工作簿，然后保存该新的工作簿并closures它。 这是通过单击活动工作表中的表单（button）触发的。 在保存之前，该button将在新的工作簿中被删除。

我正在使用活动工作表中的公式。 我试图复制只有值和任何其他格式。

新的工作簿不显示值，而只是空的单元格（不显示任何公式，这当然是好的）。 具体来说，复制具有间接公式的单元格时，问题似乎就会发生; 对原始工作簿中的其他工作表使用更简单的引用的单元格似乎没有问题。

代码如下：

Sub CopyRemoveFormAndSave() Dim RelativePath As String Dim shp As Shape Dim testStr As String ' Copy and Paste Active Sheet ActiveSheet.Copy With ActiveSheet.UsedRange .Value = .Value End With ' Remove forms For Each shp In ActiveSheet.Shapes If shp.Type = 8 Then If shp.FormControlType = 0 Then testStr = "" On Error Resume Next testStr = shp.TopLeftCell.Address On Error GoTo 0 If testStr <> "" Then shp.Delete Else shp.Delete End If End If Next shp ' Save New Workbook and Close Application.DisplayAlerts = False RelativePath = ThisWorkbook.Path & "\" & ActiveSheet.Name & "_Reporting_" & Format(Now, "yymmdd") & ".xlsx" ActiveWorkbook.SaveAs Filename:=RelativePath ActiveWorkbook.Close Application.DisplayAlerts = True End Sub 

Answer 1

这是一个稍微不同的方法。

逻辑：

1. 在用户的临时目录中创build活动工作簿的副本
2. 打开副本
3. 将公式更改为值。 格式的其余部分保持不变。
4. 删除所有不必要的表格
5. 删除不必要的形状

代码:(试过并testing过）

 Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _ (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private Const MAX_PATH As Long = 260 '~~> Function to get user's temp directoy Function TempPath() As String TempPath = String$(MAX_PATH, Chr$(0)) GetTempPath MAX_PATH, TempPath TempPath = Replace(TempPath, Chr$(0), "") End Function Sub CopyRemoveFormAndSave() Dim wb As Workbook, wbNew As Workbook Dim ws As Worksheet Dim wsName As String, NewName As String Dim shp As Shape Set wb = ThisWorkbook wsName = ActiveSheet.Name NewName = wsName & ".xlsm" wb.SaveCopyAs TempPath & NewName Set wbNew = Workbooks.Open(TempPath & NewName) wbNew.Sheets(wsName).UsedRange.Value = wbNew.Sheets(wsName).UsedRange.Value Application.DisplayAlerts = False For Each ws In wbNew.Worksheets If ws.Name <> wsName Then ws.Delete Next ws Application.DisplayAlerts = True For Each shp In wbNew.Sheets(wsName).Shapes If shp.Type = 8 Then shp.Delete Next ' '~~> Do a save as for the new workbook if required. ' End Sub 

Answer 2

这可能有点晚，作为你的答案，但可能会在未来帮助别人。

脚步：

1. 转到工作簿中的第一张
2. 按住Shiftbutton，然后单击工作簿中的最后一张（选中所有图纸）
3. 通过Ctrl + A + A或者点击列A左上angular的小箭头和第1行来select活动工作表中的所有单元格（选中活动工作表中的所有单元格）
4. 复制>>粘贴为值

该副本将粘贴为所有工作表中所有单元格的值。 保存文件为。