Effacer contenu de cellule

Sub VerifIntersection(Selection As Range)
Dim plage As Range
On Error Resume Next
Set Selection = Application.InputBox("Sélectionnez la cellule ou la plage à modifier :", Title:="  [Plage]", Type:=8)
On Error GoTo 0
'---------------------------------------------
For Each cel In Selection
  If cel.HasFormula = True Then
    MsgBox "Impossible d'effacer des formules! Veuillez resélectionner une plage", vbOKOnly + vbExclamation, "ANNULATION"
    Exit Sub
  End If
Next
'---------------------------------------------
ActiveWindow.DisplayHeadings = True
If MsgBox("Etes vous sur de vouloir effacé le contenu de ces cellules : " & Selection.Address & (" ? "), vbYesNo + vbQuestion) = vbNo Then
  ActiveWindow.DisplayHeadings = False
  Exit Sub
  Else
  If ActiveSheet.Name = "Fichier_Représentant" Then
    Set plage = Range("A6:B1010", "D6:I1010")
    If Selection.Row < 6 Or Selection.Row > 1010 Or Selection.Column > 9 Or Selection.Column = 3 Then
      MsgBox ("Erreur ! Sélection invalide ! Veuillez sélectionner une plage valide et recommencer"), vbYesNo = 1
      ActiveWindow.DisplayHeadings = False
      Else
      ActiveSheet.Unprotect
      Selection.ClearContents
      Selection.Locked = False
      MsgBox ("OPERATION effectuée avec succes !")
      ActiveWindow.DisplayHeadings = False
    End If
  End If
End If
End Sub

Dim Code as String

ActiveSheet.Unprotect
Code = Cells(Selection.Row, 3)
Selection.ClearContents
Cells(Selection.Row, 3) = Code