Office: (Office 365) Zellen Datenüberprüfung nicht löschen

Hallo zusammen,
mit dem unten stehenden Code,lösche ich den Inhalt eines Blattes.Bis auf alle gesperrten Zellen.
Nun habe ich Zellen in denen eine Datenüberprüfung für Gültigkeitskriterien(Dropdown) sind.
Diese Zellen kann ich nicht sperren weil es mehrere Auswahlmöglichkeiten gibt.
Wie kann man diese von löschen ausschließen.
Es steht immer der Text Teilenummer in den Zellen.

Danke und Gruß Merkur

Code:

Sub neuer_Monat()
Dim rngZelle As Range
Dim intFrage As Integer
intFrage = MsgBox("Neuen Monat erstellen und alle Daten löschen?", vbYesNo)
If intFrage = 6 Then
Application.Calculation = xlCalculationManual
   frmLoad.Show (0)
    Application.Wait Now + TimeValue("00:00:01")
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Worksheets(Array("XXXXXXXXX", "XXXXXXXXX")).copy
    Application.DisplayAlerts = False
        With ActiveWorkbook
        .SaveAs Filename:="\\XXXXXXX\teams\XXXXXXX\Sicherungen\" _
            & Format(Range("A2"), "MM") & "-" & Format(Range("A2"), "YYYY") & "_" & Format(Range("A2"), "MMMM") & "\" _
            & Application.Substitute(ThisWorkbook.Name, ".xlsm", "") _
            & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        .Close
    End With
  
    Application.DisplayAlerts = True
    With Worksheets("XXXXXXXXXXX")
        For Each rngZelle In .Range("A5:AB1200")
            If rngZelle.Locked = False Then rngZelle.MergeArea.ClearContents
        Next rngZelle
    End With
  
  
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Call Calculate
    Call Zeit
 Unload frmLoad
 
 End If
End Sub