Sub Harry3()
Dim arr()
    Application.ScreenUpdating = False
        Set artObj = CreateObject("VBScript.RegExp")
            artObj.Global = True
            artObj.Pattern = "Артикул: (.*?)(?=;)"
        Set kolObj = CreateObject("VBScript.RegExp")
            kolObj.Global = True
            kolObj.Pattern = "Кол-во: (\d+)"
                For Each cl In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
                    If artObj.test(cl) Then
                        Set artCol = artObj.Execute(cl)
                        ReDim arr(1 To artCol.Count * 2)
                            For x = 0 To artCol.Count - 1
                    i = i + 1
                    arr(i) = artCol.Item(x).submatches(0)
                    arr(i + 1) = kolObj.Execute(cl).Item(x).submatches(0)
                    i = i + 1
                            Next x
                        cl.Offset(0, 1).Resize(1, UBound(arr)).Value = arr
                    i = 0
                    ReDim arr(0)
                    End If
                Next
    Application.ScreenUpdating = True
End Sub