copy specific excel sheets to a new workbook as values

Question

Current code:

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

the current code is saving a copy of the whole file to the directory "D:\\cashbackup\\english", which is taking a lot of space on disk (about 3.73 MB for each save click), where as saving only sheets: payin, payout and balance as values only without the formulas created previously in excel cells in the excel project file will save much space on the hard disk (not more than 20 KB for each save click)

my need:

I want the code save a new workbook containing only specific sheets: payin, payout and balance as values in the directory: "D:\\cashbackup\\english", with the same file naming, I mean without the user forms in sheet BOX and without the macros

Thank you in advance.

Answer 1

New Version, but remember: The site it's not a place to find people that make your work, but a place to find an help for writed code... Or a starting point. The macro use the open file and make:

• delete the sheets not included in the "list"
• remove the formulas
• put all the cells in protected mode
• add password to all the sheets
• save with password (for Open & Modify)
• remove the macro from the files (saving in Xlsx)

Code:

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