将特定的Excel表单复制到新的工作簿中作为值

当前代码：

Private Sub cmdsave_Click() Dim iRow As Long Dim ws As Worksheet Set ws = Worksheets("payin") 'find first empty row in database iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _ SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1 'copy the data to the database With ws .Cells(iRow, 1).Value = Me.txtlbp.Value .Cells(iRow, 2).Value = Me.txtdollar.Value .Cells(iRow, 3).Value = Me.txtsyp.Value End With 'clear the data Me.txtlbp.Value = "" Me.txtdollar.Value = "" Me.txtsyp.Value = "" ActiveWorkbook.Save Dim savedate savedate = Date Dim savetime savetime = Time Dim formattime As String formattime = Format(savetime, "hh.MM.ss") Dim formatdate As String formatdate = Format(savedate, "DD-MM-YYYY") Application.DisplayAlerts = False If Len(Dir("D:\cashbackup\english", vbDirectory)) = 0 Then MkDir "D:\cashbackup\english" End If Dim backupfolder As String backupfolder = "D:\cashbackup\english\" ActiveWorkbook.SaveCopyAs Filename:=backupfolder & "payin" & formatdate & " " & formattime & " " & ActiveWorkbook.Name Application.DisplayAlerts = False txtlbp.SetFocus End Sub 

当前的代码是将整个文件的副本保存到磁盘上占用大量空间（每个保存点击大约3.73 MB）的目录“D：\ cashbackup \ english”，其中仅保存工作表：payin，支付和余额作为值只有在excel项目文件中的Excel单元格中创build的公式将节省硬盘上的空间（每个保存点击不超过20 KB）

我的需要：

我想要的代码保存一个新的工作簿，只包含特定的工作表：payin，支付和余额作为目录中的值：“D：\ cashbackup \ english”，具有相同的文件命名，我的意思是没有表单中的用户表单，macros

先谢谢你。

Answer 1

新版本，但请记住：该网站不是一个find工作的人的地方，而是一个寻找writed代码帮助的地方……或者是一个起点。 macros使用打开的文件，并使：

• 删除未包含在“列表”中的工作表
• 删除公式
• 把所有的细胞置于保护模式
• 为所有表单添encryption码
• 保存密码（打开和修改）
• 从文件中删除macros（保存在XLSX中）

码：

 Application.DisplayAlerts = False For Each xx In ActiveWorkbook.Sheets If xx.Name = "Sheet1" Or xx.Name = "Sheet3" Then xx.Select Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Selection.Locked = True ActiveSheet.Protect Password:="ShPwd", DrawingObjects:=True, Contents:=True, Scenarios:=True Else xx.Delete End If Next tmp = " - " & Format(Date, "DD-MM-YYYY") & " - " & Format(Time, "HH-MM-SS") ActiveWorkbook.Protect Password:="ShPwd", Structure:=True, Windows:=False ActiveWorkbook.SaveAs Filename:="E:\0\New folder\aa" & tmp & ".xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False, Password:="Open" _ , WriteResPassword:="Modify" ActiveWindow.Close Application.DisplayAlerts = True