Sub Clear_1()
    Dim sFolder As String, sFiles As String, wb As Workbook, rng As Range, rc As Range, ws As Worksheet
    Set Re = CreateObject("VBScript.RegExp")
    Re.IgnoreCase = True:    Re.Pattern = "<(/?)(?:name|desc)>"
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        Set wb = Application.Workbooks.Open(sFolder & sFiles)
        For Each ws In Worksheets     ' Если не нужно удалять на всех листах, то удалите или закомментируйте эту строку
            For Each rc In ws.UsedRange.SpecialCells(xlCellTypeConstants)     ' Если не нужно удалять на всех листах, то закомментируйте эту строку и раскомментируйте следующую
'            For Each rc In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)     ' Будет удалять только на активном листе
                If Not Re.Test(rc.Value) Then
                    If rng Is Nothing Then Set rng = rc Else Set rng = Union(rng, rc)
                End If
            Next rc
            If Not rng Is Nothing Then rng.Clear
            Set rng = Nothing
        Next ws     'Если не нужно удалять на всех листах, то удалите или закомментируйте эту строку
        wb.Close True
        sFiles = Dir
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub