Sub iName()
Dim mo As Object
Dim n As Integer
 With CreateObject("VBScript.RegExp")
     .Global = True
     .MultiLine = True
     .Pattern = "Название (.+)(?= ИНН:)"
   If .test(Cells(1, 1)) Then
     Set mo = .Execute(Cells(1, 1))
     For n = 0 To mo.Count - 1
       Cells(1, 2 + n) = Mid(mo(n), 10)
     Next
   Else
     Cells(1, 1) = ""
   End If
 End With
End Sub

Sub mrshkei()
Dim arr, arr2, arr3, arr4, lr As Long
Dim i As Long, n As Long, x1 As Long, x2 As Long, x3 As Long, x4 As Long, x5 As Long
Range("C:H").Clear
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Array("Название", "ИНН", "Телефон", "Email", "Адрес", "Цена в заявке")
arr2 = Range("A1:A" & lr)
ReDim arr4(1 To lr * 20, 1 To 6): k = 1
For i = LBound(arr2) To UBound(arr2)
    arr3 = Split(arr2(i, 1), Chr(10))
    For n = LBound(arr3) To UBound(arr3)
        If Len(arr3(n)) > 10 Then
            x1 = Len(arr(0))
            x2 = InStr(arr3(n), arr(1))
            x3 = InStr(arr3(n), arr(2))
            x4 = InStr(arr3(n), arr(3))
            x5 = InStr(arr3(n), arr(4))
            x6 = InStr(arr3(n), arr(5))
            x7 = InStr(arr3(n), " руб.")
            
            arr4(k, 1) = Mid(arr3(n), x1 + 2, x2 - x1 - 3) ' название
            arr4(k, 2) = CStr(Mid(arr3(n), x2 + 5, 10)) ' ИНН
            arr4(k, 3) = CStr(Mid(arr3(n), x3 + Len(arr(2)) + 2, x4 - x3 - 10)) ' Телефон
            arr4(k, 4) = Mid(arr3(n), x4 + Len(arr(3)) + 2, x5 - x4 - 8) ' email
            arr4(k, 5) = Mid(arr3(n), x5 + Len(arr(4)) + 2, x6 - x5 - 8) ' Адрес
            arr4(k, 6) = Mid(arr3(n), x6 + Len(arr(5)) + 2, x7 - (x6 + Len(arr(5)) + 2)) ' сумма
            k = k + 1
        End If
    Next n
Next i
Range("C1").Resize(1, 6) = arr
Range("C2").Resize(UBound(arr4), 6) = arr4
End Sub