Ne supprimer que les cellules déverrouillées

Sub Effacer_CDeverouillees_SF()
Dim Plage As Range, A_Effacer As Range, Rng As Range
On Error Resume Next
Set Plage = ActiveSheet.UsedRange
Application.ScreenUpdating = False
For Each Rng In Plage
    If Not Rng.Locked  And Not Rng.HasFormula Then
        If A_Effacer.Count = 0 Then
        Set A_Effacer = Rng
        Else
        Set A_Effacer = Union(A_Effacer, Rng)
        End If
    End If
Next
If A_Effacer.Count > 0 Then A_Effacer.ClearContents
End Sub

Sub Effacer()
Cells.SpecialCells(xlCellTypeConstants) = ""
End Sub

Sub Effacer_FindFormat()
Dim t
t = Timer
Application.FindFormat.Clear
Application.FindFormat.Locked = False
Cells.Replace "*", "", SearchFormat:=True
Application.FindFormat.Clear
MsgBox "Effacement en " & Format(Timer - t, "0.00 \s"), , "FindFormat" 'chez moi => 14,2 s
End Sub

Sub Effacer_tableau()
Dim t, P As Range, cc%, tablo, i&, j%
t = Timer
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
Set P = ActiveSheet.UsedRange
cc = P.Columns.Count
tablo = P.Resize(P.Rows.Count + 1).Formula 'au moins 2 éléments
For i = 1 To UBound(tablo) - 1
  For j = 1 To cc
    If Not P(i, j).Locked Then tablo(i, j) = ""
Next j, i
ActiveSheet.UsedRange = tablo
MsgBox "Effacement en " & Format(Timer - t, "0.00 \s"), , "Tableau" 'chez moi => 1,8 s
End Sub