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

Question

我有一个 VBA 脚本，它在“Sheet1”中的一个范围内搜索黄色 (6) 的单元格并锁定这些单元格。这些单元格受到有意保护，因此无法更改。然后我的脚本复制“Sheet2”中的一个范围并将其粘贴到“Sheet1”中，但是我收到错误消息，说单元格受到保护。我需要的是脚本跳过锁定在“Sheet1”中的单元格，但粘贴到该范围内未锁定的所有其他单元格。我希望锁定单元的完整性保持不变。这是我目前所拥有的：

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