Function ТЕКСТМЕЖДУ(cl, s1 As String, n1 As Long, s2 As String, n2 As Long) As String
'cl - текст, или ссылка на ячейку с текстом, откуда вырезаем текст
's1 - первый граничный символ
'n1 - номер вхождения первого символа
's2 - второй граничный символ
'n2 - номер вхождения второго символа
With Application.WorksheetFunction
    If s1 = s2 Then
         cl = .Substitute(.Substitute(cl, s1, Chr(5), n1), s2, Chr(6), n2 - 1)
         s1 = Chr(5)
         s2 = Chr(6)
         n1 = 1
         n2 = 1
    End If
    If n1 > 1 Then
        cl = .Substitute(cl, s1, Chr(5), n1)
        s1 = Chr(5)
        n1 = 1
    End If
    If n2 > 1 Then
        cl = .Substitute(cl, s2, Chr(6), n2)
        s2 = Chr(6)
        n2 = 1
    End If
    f1 = .Search(s1, CStr(cl), n1) + 1: f2 = .Search(s2, CStr(cl), n2)
    If f2 - f1 < 0 Then Exit Function
    ТЕКСТМЕЖДУ = Mid(CStr(cl), f1, f2 - f1)
End With
End Function

Sub iDSP()
Dim mo As Object
Dim n As Integer
 With CreateObject("VBScript.RegExp")
   .Global = True
   .IgnoreCase = 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, n + 2) = Mid(mo(n), 2)
         Next
    End If
 End With
End Sub

 Sub test2()
   Dim t$, i&: t = Range("B4")
  With CreateObject("VBScript.RegExp"): .Pattern = "<(.+?)>": .Global = True
     For i = 0 To .Execute(t).Count - 1: Range("B8").Offset(i).Value = .Execute(t)(i).Submatches(0): Next
  End With
End Sub