Sub Trim_By_Formula() ' применить функцию СЖПРОБЕЛЫ к ячейкам выделенного диапазона
   Dim iCell As Range, rRange As Range
Set rRange = Intersect(Selection, ActiveSheet.UsedRange)
Application.ScreenUpdating = False    

     k = MsgBox("Хотите заменить ПРОБЕЛ на АБЗАЦ?", Buttons:=vbYesNo)
     Caption = k

         If k = 6 Then

For Each iCell In rRange
With iCell
                 'chr(10) - это знак абзаца - тут заменяем пробелы на абзацы и выравниваем по центру
                 .Replace What:=" ", Replacement:=Chr(10), LookAt:=xlPart, SearchOrder:= _
                         xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
                 With Selection
                 .HorizontalAlignment = xlCenter
                 .VerticalAlignment = xlCenter
                 End With
         Else
      
             If .EntireRow.Height > 0 _
                 And Not (.HasFormula) _
                 And Not IsDate(.Value) _
                 And Not .NumberFormat Like "*" & ":" & "*" Then 'если строка не скрыта и в ячейке не формула, не дата, не время
                 .Value = Application.WorksheetFunction.Trim(.Value)
             End If

         End If

End With
Next

     Application.ScreenUpdating = True
     rRange.Select

End Sub

k = MsgBox("Хотите заменить ПРОБЕЛ на АБЗАЦ?", Buttons:=vbYesNo)
Caption = k
If k = 6 Then

If MsgBox("Хотите заменить ПРОБЕЛ на АБЗАЦ?", vbYesNo)=vbYes Then

.Select

If MsgBox("Хотите заменить ПРОБЕЛ на АБЗАЦ?", vbYesNo)=vbYes Then .Replace " ", vbLf, xlPart

If MsgBox("Хотите заменить ПРОБЕЛ на АБЗАЦ?", 4)-7 Then .Replace " ", Chr(10), 2

Sub Trim_By_Formula()   ' применить функцию СЖПРОБЕЛЫ к видимым ячейкам выделенного диапазона
      If TypeName(Selection) <> "Range" Then Exit Sub
      'If Not TypeOf Selection Is Range Then Exit Sub
      Dim rRng As Range, rSubRng As Range
      With ActiveSheet.UsedRange
      Set rRng = Intersect(Selection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants))
      End With
      Application.ScreenUpdating = False: Application.EnableEvents = False
      With rRng
      .Replace Chr(160), " ", xlPart   ' Chr(160) - неразрывный пробел
      For Each rSubRng In .Areas
          rSubRng.Value = Application.Trim(rSubRng.Value)   ' СЖПРОБЕЛЫ
      Next
      .Replace " " & Chr(10), Chr(10), xlPart   ' пробел перед LF
      .Replace Chr(10) & " ", Chr(10), xlPart  ' пробел после LF
       
      'vbLf = Chr(10) = пробел
      If MsgBox("Хотите заменить ПРОБЕЛ на АБЗАЦ?", vbYesNo) = vbYes Then .Replace " ", vbLf, xlPart
      .Select
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlBottom
      .VerticalAlignment = xlCenter
      End With
      Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub

    .HorizontalAlignment = xlCenter
     .VerticalAlignment = xlCenter

Sub Text_Center(): Selection.VerticalAlignment = xlCenter: End Sub