[英]copy specific excel sheets to a new workbook as values
當前代碼:
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,僅在沒有Excel項目文件的excel單元中以前創建的公式的情況下,才將支付和余額作為值,這將節省硬盤上的大量空間(每次保存單擊不超過20 KB)
我的需求:
我希望代碼保存一個僅包含特定工作表的新工作簿:付款,付款和余額作為目錄中“ D:\\ cashbackup \\ english”中的值,並使用相同的文件命名,我的意思是在工作表BOX中沒有用戶表格並且沒有宏
先感謝您。
新版本,但請記住:該網站不是尋找工作人員的地方,而是尋找書面代碼幫助的地方...還是起點。 宏使用打開的文件並進行以下操作:
碼:
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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.