Alle Werte einer Excel-Arbeitsmappe glätten

Sub TrimCells()
' Das Makro glättet alle Werte in der gesamten Arbeitsmappe
Dim intX As Integer

intX = MsgBox("Alle Daten der Arbeitsmappe glätten?", vbQuestion + vbYesNo, "Glätten")
    If intX = vbYes Then

  Dim objSh As Worksheet
  Dim rng As Range, rngR As Range
  Dim lngCalc As Long
  
  On Error GoTo ErrExit
  
  With Application
    .EnableEvents = False
    .ScreenUpdating = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
  End With
  
  For Each objSh In ThisWorkbook.Worksheets
    On Error Resume Next
    Set rngR = objSh.UsedRange.SpecialCells(xlCellTypeConstants)
    Err.Clear
    On Error GoTo ErrExit
    
    If Not rngR Is Nothing Then
      For Each rng In rngR
        rng = Trim(rng)
      Next
    End If
  Next
  
ErrExit:
  
  With Application
    .EnableEvents = True
    .ScreenUpdating = True
    .Calculation = lngCalc
  End With
  
  Set rng = Nothing
  Set rngR = Nothing
  Set objSh = Nothing


    MsgBox "Alle Daten wurden geglättet.", vbInformation + vbOKOnly, "Glätten erfolgreich"
  
    Else

    MsgBox "Glätten abgebrochen.", vbInformation + vbQuestion, "Abbruch"

    End If
    
End Sub