Sub ertert()
With Range("A1:F" & Cells(Rows.Count, 1).End(xlUp).Row)
     .Value = Application.Clean(.Value)
     'или даже так
     '.Value = Application.Trim(Application.Clean(.Value))
End With
End Sub

Sub Trim_By_Formula()   ' применить функцию СЖПРОБЕЛЫ к видимым ячейкам выделенного диапазона
     Dim rRng As Range, rSubRng As Range
     Set rRng = Intersect(ActiveWindow.RangeSelection.SpecialCells(xlCellTypeVisible), ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants))
     If rRng Is Nothing Then: Call Groups_Tuning: Exit Sub
     Application.ScreenUpdating = False: Application.EnableEvents = False
     With rRng
        .Replace Chr(160), " ", xlPart   ' Chr(160) - неразрывный пробел
        For Each rSubRng In .Areas
           rSubRng.Value = Application.Trim(rSubRng)   ' СЖПРОБЕЛЫ
        Next
        .Replace " " & Chr(10), Chr(10), xlPart   ' пробел перед LF
        .Replace Chr(10) & " ", Chr(10), xlPart  ' пробел после LF
        .Select
     End With
     Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub

.Value = Application.WorksheetFunction.Clean(.Value)