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

Question

当前代码：

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

当前代码将整个文件的副本保存到目录“D:\cashbackup\english”，这会占用大量磁盘空间（每次保存单击大约 3.73 MB），而只保存工作表: payin、payout 和 balance 作为值，没有之前在 excel 项目文件的 excel 单元格中创建的公式，将节省大量硬盘空间（每次保存不超过 20 KB）

我的需要：

我希望代码保存一个仅包含特定工作表的新工作簿：payin、payout 和 balance 作为目录中的值：“D:\cashbackup\english”，具有相同的文件命名，我的意思是工作表中没有用户表单BOX，不带宏

提前谢谢你。

Answer 1

新版本，但请记住：该网站不是寻找工作人员的地方，而是寻找编写代码帮助的地方......或起点。宏使用打开的文件并制作：

• 删除“列表”中未包含的工作表
• 删除公式
• 将所有单元格置于保护模式
• 为所有工作表添加密码
• 用密码保存（用于打开和修改）
• 从文件中删除宏（保存在 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