我有以下代码将一个工作表复制到另一个工作表并仅粘贴值但是保护工作表的代码不起作用?我在这做错了什么?
Sub GetQuote()
Range("AK548").Select
Selection.Copy
Range("AK549").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim ws As Worksheet
Dim sDataOutputName As String
With Application
.Cursor = xlWait
.StatusBar = "Saving Quote & Proposal Sheet..."
.ScreenUpdating = False
' Copy specific sheets
' *SET THE SHEET NAMES TO COPY BELOW*
' Array("Sheet Name", "Another sheet name", "And Another"))
' Sheet names go inside quotes, seperated by commas
On Error GoTo ErrCatcher
Sheets(Array("Quote & Proposal")).Copy
On Error GoTo 0
' Paste sheets as values
' Remove External Links, Hperlinks and hard-code formulas
' Make sure A1 is selected on all sheets
For Each ws In ActiveWorkbook.Worksheets
ws.Cells.Copy
ws.[A1].PasteSpecial Paste:=xlValues
ws.Cells.Hyperlinks.Delete
Application.CutCopyMode = False
Cells(1, 1).Select
ws.Activate
Next ws
Cells(1, 1).Select
sDataOutputName = ThisWorkbook.Path & "\" & ThisWorkbook.Worksheets("Quote Questions").Range("AK545").Value & ".xlsx"
' Save it with the NewName and in the same directory as original
ActiveWorkbook.SaveCopyAs sDataOutputName
ActiveWorkbook.Protect Password:="12345"
ActiveWorkbook.Close SaveChanges:=False
.Cursor = xlDefault
.StatusBar = False
.ScreenUpdating = True
End With
Exit Sub
ErrCatcher:
MsgBox "Specified sheets do not exist within this workbook"
End Sub
答案 0 :(得分:2)
您的代码正在显示工作预订,而不是工作表保护。如果要保护工作表,请使用工作表保护:
ws.Protect Password:="12345", DrawingObjects:=True, Contents:=True, Scenarios:=True
'ADD AND REMOVE PARAMETERS AS YOU WANT THEM
答案 1 :(得分:2)
您正在保护工作簿并设置密码,在关闭工作簿但未保存更改的下一行代码中。
答案 2 :(得分:0)
我在代码行ActiveSheet.Protect Password:="12345"
上面放了ActiveWorkbook.SaveCopyAs sDataOutputName
并且它有用了!