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

Copy entire sheet and paste as values

提问by Nick

I am trying to copy the active worksheet into a new workbook, then save that new workbook and close it. This is triggered by clicking on a form (button) in the active worksheet. The button is then removed in the new workbook prior to saving.

我正在尝试将活动工作表复制到新工作簿中，然后保存该新工作簿并关闭它。这是通过单击活动工作表中的表单（按钮）触发的。然后在保存之前在新工作簿中删除该按钮。

I am using formulas in the active worksheet. I am trying to copy only the values and any additional formatting.

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

The new workbook does not show the values, but instead only empty cells (no formulas are shown either, which is of course ok). Specifically, the problem seems to occur when copying cells with indirect formulas; it seems to be no problem for cells that use simpler references to other sheets in the original workbook.

新工作簿不显示值，而只显示空单元格（也不显示公式，这当然没问题）。具体来说，在使用间接公式复制单元格时似乎会出现该问题；对于使用对原始工作簿中其他工作表的更简单引用的单元格似乎没有问题。

Here's the code:

这是代码：

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

回答by Siddharth Rout

Here is a slightly different approach.

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

Logic:

逻辑：

1. Create a copy of the active workbook in user's temp directory
2. Open the copy
3. Change formulas to values. The rest of the formatting remains untouched.
4. Delete all unnecessary sheets
5. Delete unnecessary shapes.

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

Code: (Tried and tested)

代码：（尝试和测试）

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

回答by M.L

This might be a bit late as an answer for you, but might help someone else in future.

这对您来说可能有点晚了，但将来可能会帮助其他人。

Steps:

脚步：

1. Go to the First Sheet in the Workbook
2. Hold Shiftbutton and click on the Last Sheet in the Workbook (All your sheets are selected)
3. Select all cells in the active sheet by doing Ctrl+A+A, or, clicking the little arrow on the top left cusp of column A and row 1. (All cells in the active sheet are selected)
4. Copy >> Paste as Values

1. 转到工作簿中的第一张工作表
2. 按住Shift按钮并单击工作簿中的最后一张纸（所有工作表都被选中）
3. 通过执行Ctrl+ A+选择活动工作表中的所有单元格A，或者单击 A 列和第 1 行左上角的小箭头。（活动工作表中的所有单元格都被选中）
4. 复制 >> 粘贴为值

This copy pastes as values for all cells in all sheets. Save file As.

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