Knap der kun sletter celler åbne celler (ikke låste)

Sub test()
Dim WorkRgn As Range
Dim OutRgn As Range
Dim Rgn As Range

On Error Resume Next
Set WorkRgn = Application.ActiveSheet.Range("D4:CR154")
Application.ScreenUpdating = False
For Each Rgn In WorkRgn
    If Rgn.Locked = False Then
        If OutRgn.Count = 0 Then
            Set OutRgn = Rgn
        Else
            Set OutRgn = Union(OutRgn, Rgn)
        End If
    End If
Next
If OutRgn.Count > 0 Then OutRgn.ClearContents
Application.ScreenUpdating = True

End Sub

Sub test()
Dim WorkRgn As Range
Dim OutRgn As Range
Dim Rgn As Range

On Error Resume Next
Set WorkRgn = Application.ActiveSheet.Range("D4:CR154")
Application.ScreenUpdating = False
For Each Rgn In WorkRgn
    If Rgn.Locked = False Then
        If OutRgn.Count = 0 Then
            Set OutRgn = Rgn
        Else
            Set OutRgn = Union(OutRgn, Rgn)
        End If
    End If
Next
If OutRgn.Count > 0 Then OutRgn.ClearContents

ActiveSheet.Range("EB5:EB39").ClearContents
ActiveSheet.Range("IK3:IK37").ClearContents

Application.ScreenUpdating = True

End Sub