jak evektivnejc by to slo

Sub MakeLines()
    Dim aCell As Range
    Dim aValues() As String
    Dim aBound As Integer
    
    Application.ScreenUpdating = False
    Set aCell = Range("A1")
    Do While aCell <> ""
        aValues = Split(aCell, Chr(10))
        aBound = UBound(aValues)
        If aBound > 0 Then
            aCell.EntireRow.Resize(aBound).Insert
            aCell.Offset(-aBound).Resize(aBound + 1) = WorksheetFunction.Transpose(aValues)
        End If
        Set aCell = aCell.Offset(1)
    Loop
    Application.ScreenUpdating = True
End Sub