把工作簿内所有工作表导出到桌面生成新工作簿并去掉公式及代码

Sub 另存为()

    Dim cPath$, cFile$, sh As Worksheet, shp As Shape, Arr()

    If MsgBox("点击“确定”生成文件到桌面", vbYesNo) <> vbYes Then Exit Sub     '生成文件

    cPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"

    Application.DisplayAlerts = False

    Application.ScreenUpdating = False

    With ActiveWorkbook

        For Each sh In .Worksheets

            cFile = sh.Range("k1").Value

            If cFile <> "" Then

                sh.Copy

                With ActiveWorkbook

                    For Each shp In .Sheets(1).Shapes

                        shp.Delete '删除按钮

                    Next

                    .Sheets(1).UsedRange.Value = .Sheets(1).UsedRange.Value

                    .SaveAs Filename:=cPath & cFile & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

                    .Close

                End With

            End If

        Next

        Application.DisplayAlerts = True

        Application.ScreenUpdating = True

        .Close

    End With

End Sub