Sub Кнопка1_Щелчок()
Columns("K:M").ClearContents
cr = 1
arr = Range("A2:C" & Cells(Rows.Count, 1).End(xlUp).Row).Value
For i = 1 To UBound(arr)
ss = Split(arr(i, 2), Chr(10))
For j = 0 To UBound(ss)
Cells(cr, "K") = arr(i, 1)
Cells(cr, "L") = ss(j)
Cells(cr, "M") = arr(i, 3)
cr = cr + 1
Next
Next
End Sub
Sub Main()
Dim a As Variant
Dim c As Range
Dim i As Long
For Each c In Selection.Cells
a = Split(c.Value, Chr(10))
If UBound(a) > 0 Then
c.Offset(1, -1).Resize(UBound(a), 3).Insert Shift:=xlDown
c.Offset(0, -1).Resize(1, 3).Copy c.Offset(1, -1).Resize(UBound(a), 3)
c.Offset(0, 0).Resize(UBound(a) + 1, 1) = Application.Transpose(a)
End If
Next
End Sub