Split text to columns and transfer to rows VBA

Sub test()
    Dim a, b, i As Long, ii As Long, x, e, n As Long
    a = Sheets("suivi").Cells(1).CurrentRegion.Value
    ReDim b(1 To 10000, 1 To 11)
    For i = 1 To UBound(a, 1)
        x = SplitRef(a(i, 3))
        For Each e In x
            n = n + 1
            b(n, 1) = a(i, 1): b(n, 2) = e
            For ii = 5 To 13
                b(n, ii - 2) = a(i, ii)
            Next
        Next
    Next
    With Sheets("result").Cells(1).Resize(n, 11)
        With .CurrentRegion
            .Borders.LineStyle = xlNone
            .ClearContents
        End With
        .Value = b
        .Cells(1, 2).Value = "PN " & .Parent.Name
        With .Cells(1, 4).Resize(, 7)
            .Value = .Parent.Evaluate("""" & .Parent.Name & """&char(10)&" & .Address)
        End With
        .Borders.Weight = 2
    End With
End Sub




Function SplitRef(ByVal txt As String)
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "/-+[A-Z]*; *"
        If .test(txt) Then
            SplitRef = Split(Trim$(.Replace(txt, " ")))
        Else
            SplitRef = Array(txt)
        End If
    End With
End Function