VBA粘贴到具有锁定单元格的范围内，但跳过锁定的单元格

Question

我有一个VBA脚本搜索＆＃34; Sheet1＆＃34;对于黄色细胞（6）并锁定这些细胞。这些细胞受到有意保护，因此无法更换。然后我的脚本在＆＃34; Sheet2＆＃34;中复制一个范围。并将其粘贴到＆＃34; Sheet1＆＃34;但是我得到错误消息，说明细胞受到保护。我需要的是脚本跳过锁定在＆＃34; Sheet1＆＃34;但粘贴到该范围内已解锁的所有其他单元格。我希望锁定单元格的完整性保持不变。这就是我到目前为止所做的：

Sub lockcellsbycolor()

    Dim colorIndex As Integer
    colorIndex = 6
    Dim xRg As Range
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect

    For Each xRg In ActiveSheet.Range("A1:D40").Cells
        Dim color As Long
        color = xRg.Interior.colorIndex
        If (color = colorIndex) Then
            xRg.Locked = True
        Else
            xRg.Locked = False
        End If
    Next xRg
    Application.ScreenUpdating = True
    ActiveSheet.Unprotect
    MsgBox "All specified colour cells have been locked!"
    ActiveSheet.Protect

'grab data from sheet 2 and paste into "Sheet1"
    Sheets("Sheet2").Select
    Range("A1:D40").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'I need this paste to ignore locked cells - meaning any cell that's locked is not pasted over the top of but rather skipped. (See picture for an example of the desired outcome)

End Sub

Answer 1

你不必要地迭代两次：只复制黄色单元格中的值

Option Explicit

Sub lockcellsbycolor()
    Dim colorIndex As Integer
    colorIndex = 6
    Dim xRg As Range

    Application.ScreenUpdating = False
    ActiveSheet.Unprotect

    For Each xRg In Sheets("Sheet1").Range("A1:D40").Cells
        Dim color As Long
        color = xRg.Interior.colorIndex
        If color <> colorIndex Then xRg.Value = Sheets("Sheet2").Range(xRg.Address).Value
    Next
End Sub