Const RANGE_IN = "A2:A74"
Const RANGE_OUT = "A1"

Sub SplitByChr10()
    Dim arr As Variant
    arr = Sheets("Лист1").Range(RANGE_IN)
    Dim rOut As Range
    Set rOut = Sheets("сюда").Range(RANGE_OUT)
    Dim brr As Variant
    Dim x As Integer
    x = Range(RANGE_OUT).Column
    With rOut.Parent.Range(rOut.Parent.Range(RANGE_OUT), rOut.Parent.Cells(Rows.Count, x))
        .ClearContents
        .Font.Bold = False
        .HorizontalAlignment = xlLeft
    End With
    rOut.EntireColumn.ColumnWidth = 85
    rOut.EntireColumn.WrapText = True
    Dim y As Long
    Dim u As Long
    For y = 1 To UBound(arr, 1)
        brr = Split(arr(y, 1), Chr(10))
        u = rOut.Parent.Cells(Rows.Count, x).End(xlUp).Row + 1
        u = Application.Max(Range(RANGE_OUT).Row, u)
        If UBound(brr) < 0 Then
            ReDim brr(1 To 1)
            brr(1) = " "
        End If
        rOut.Parent.Cells(u, x).Resize(UBound(brr) + 1, 1) = Application.Transpose(brr)
        With rOut.Parent.Cells(u, 1)
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
        End With
    Next
    u = rOut.Parent.Cells(Rows.Count, x).End(xlUp).Row + 1
    rOut.Parent.PageSetup.PrintArea = Cells(1, 1).Resize(u).Address
End Sub