Sub Test()
    Dim c As Range, regex As Object, matches As Object, match As Object, cellValue As String, rowNum As Long
    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "(\d+)\s*-\s*(\d+)\s+(.+?)\s+(\d{1,3}(?:,\d{3})*,\d+)\s+(.+?)\s+(\d+)"
    regex.Global = True
    For Each c In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        cellValue = c.Value
        If regex.Test(cellValue) Then
            Set matches = regex.Execute(cellValue)
            rowNum = c.Row
            For Each match In matches
                Cells(rowNum, 2).Value = match.SubMatches(0)
                Cells(rowNum, 3).Value = match.SubMatches(1)
                Cells(rowNum, 4).Value = match.SubMatches(2)
                Cells(rowNum, 5).Value = match.SubMatches(3)
                Cells(rowNum, 6).Value = match.SubMatches(4)
                Cells(rowNum, 7).Value = match.SubMatches(5)
                rowNum = rowNum + 1
            Next match
        Else
            Cells(rowNum, 2).Value = cellValue
            rowNum = rowNum + 1
        End If
    Next c
End Sub