Скопируйте листовую вставку как значения, но пропустите защищенные ячейки

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

но не работает, выдает ошибку в ошибке 438 «для каждой ячейки листа», что объект не определен или что-то в этом роде.

Есть предложения?

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