Question

我正在循环浏览几张纸，想要删除那些我不想要的纸张。对于我想要保持的人，我正在复制一切并粘贴为价值观。问题是有受保护的细胞，我不能保护，这给我一个错误。怎么避免呢？

Sub save()

Dim wb As Workbook
Dim path As String
Dim fname As String
Dim fdate As Date

' picks up the date of the reporting period so it uses it for naming the new workbook
fdate = Sheets("Instructions").Range("D1").Value
Sheets("Introduction").Range("F9").Copy
Sheets("Introduction").Range("F9").PasteSpecial xlPasteValues
Sheets("Introduction").Range("F10").Copy
Sheets("Introduction").Range("F10").PasteSpecial xlPasteValues

Application.DisplayAlerts = False
'FOR EACH SHEET IN THE WORKBOOK THAT IS ONE OF THE 5 ONES WE WANT TO SAVE IS COPIES AND PASTES AS VALUES AND DELETES THE ONES THAT ARE NOT NAMES AS BELOW
For Each Sheet In ActiveWorkbook.Sheets
    If Sheet.Name = "Introduction" Or Sheet.Name = "Instructions" Or Sheet.Name = "Results" Then
        Sheet.Select
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Selection.Locked = True
        Sheet.Range("D2") = fdate

        ActiveSheet.Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
    Else
        'if sheet is not one of the X it gets deleted
        Sheet.Delete
    End If
Next

' adding the name we wish to give the new workbook
fname = Sheets("Introduction").Range("F7") & "Result" & fdate
path = Application.ActiveWorkbook.path
'ActiveWorkbook.Protect Password:="password", Structure:=True, Windows:=False


'saves the workbook as the name we chose and date
Application.ActiveWorkbook.SaveAs Filename:=path & "\" & fname, _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

'close the workbook
ActiveWindow.Close
Application.DisplayAlerts = True


End Sub

我尝试了一些代码：

for each cell in sheet 
   if Not cell.Locked then
     cell.copy
     cell.pastespecial xlpastevalues
   end if
next

但是不起作用，它给了我在＆＃34;中的每个单元格中的错误＆＃34;错误438，没有定义obect或类似的东西。

有什么建议吗？

Answer 1

缺少单元格的声明，接下来需要在工作表中循环一个范围（.UsedRange循环遍历工作表中所有使用过的单元格）。这应该有效：

Dim cell As Range
for each cell in sheet.UsedRange
   if Not cell.Locked then
     cell.copy
     cell.pastespecial xlpastevalues
   end if
next

将表格粘贴复制为值但跳过受保护的单元格

1 个答案: