Sub escalations()
    
    Dim sh As Worksheet
    Set sh = ActiveSheet
    
    Dim y As Long
    Dim x As Integer
    Dim arr As Variant
    With sh
        y = .Cells(.Rows.Count, 1).End(xlUp).Row
        x = .Cells(1, .Columns.Count).End(xlToLeft).Column
        arr = .Range(.Cells(1, 1), .Cells(y, x))
    End With
    
    Dim e As Integer
    For x = 1 To UBound(arr, 2)
        If arr(1, x) = "escalations" Then
            e = x
            Exit For
        End If
    Next
    If e = 0 Then
        MsgBox "Не найден столбец escalations", vbInformation
        Exit Sub
    End If
    
    Dim u As Long
    u = 1
    Dim wb As Workbook
    Set wb = Workbooks.Add(1)
    sh.Rows(1).Copy wb.Sheets(1).Cells(u, 1)
    
    Dim aEx As Variant
    Dim vEx As Variant
    Dim brr As Variant
    ReDim brr(1 To 1, 1 To UBound(arr, 2))
    For y = 2 To UBound(arr, 1)
        aEx = Split(arr(y, e), " ")
        For Each vEx In aEx
            For x = 1 To UBound(brr, 2)
                brr(1, x) = arr(y, x)
            Next
            brr(1, e) = vEx
            u = u + 1
            wb.Sheets(1).Cells(u, 1).Resize(1, UBound(brr, 2)) = brr
        Next
        
    Next
End Sub