Sub Test()
  Selection.FormulaLocal = Selection.FormulaLocal
End Sub

Sub FixAllLineBreakIssues()
    Dim cell As Range
    Dim originalText As String
    Dim fixedText As String
    
    Application.ScreenUpdating = False
    
    For Each cell In ActiveSheet.UsedRange
        If cell.Value <> "" Then
            originalText = cell.Value
            
            ' Шаг 1: Нормализация переносов строк
            fixedText = Replace(originalText, vbLf, vbCrLf)
            fixedText = Replace(fixedText, vbCr, vbCrLf)
            
            ' Удаляем двойные переносы
            Do While InStr(fixedText, vbCrLf & vbCrLf) > 0
                fixedText = Replace(fixedText, vbCrLf & vbCrLf, vbCrLf)
            Loop
            
            ' Шаг 2: Удаляем переносы в начале и конце
            fixedText = Trim(fixedText)
            
            ' Шаг 3: Применяем исправленный текст
            If originalText <> fixedText Then
                cell.Value = fixedText
            End If
            
            ' Шаг 4: Включаем перенос текста
            cell.WrapText = True
        End If
    Next cell
    
    ' Шаг 5: Автоподбор размеров
    ActiveSheet.UsedRange.EntireRow.AutoFit
    ActiveSheet.UsedRange.EntireColumn.AutoFit
    
    Application.ScreenUpdating = True
    
    MsgBox "Исправление переносов строк завершено!", vbInformation
End Sub