Sub FixSelectedReferences()
Dim vList As Variant, vItem As Variant
Dim i As Integer, j As Integer
Dim oDoc As Document, oTmp As Document
    vList = Split(Selection.Text, ";")
    Set oDoc = ActiveDocument
    Set oTmp = Documents.Add
    For i = 0 To UBound(vList)
        vItem = Split(vList(i), ",")
        For j = 0 To UBound(vItem)
            oTmp.Range.InsertAfter Trim(vItem(j))
            If j < UBound(vItem) Then oTmp.Range.InsertParagraphAfter
        Next j
        If i < UBound(vList) Then oTmp.Range.InsertParagraphAfter
    Next i
    Selection.Text = FixList(oTmp)
lbl_Exit:
    Set oDoc = Nothing
    Set oTmp = Nothing
    Exit Sub
End Sub

Private Function FixList(oTmp As Document) As String
Dim oPara As Paragraph
Dim oRng As Range
Dim i As Integer
Dim sRef As String
    For i = 1 To oTmp.Range.Paragraphs.Count
        Set oPara = oTmp.Range.Paragraphs(i)
        Set oRng = oPara.Range
        oRng.Collapse (1)
        If IsNumeric(Left(oPara.Range, 1)) = False Then
            oRng.MoveEndUntil Chr(32)
            sRef = oRng.Text & Chr(32)
        Else
            oRng.Text = sRef
        End If
    Next i
    Set oRng = oTmp.Range
    With oRng.Find
        .Text = "^p"
        .Replacement.Text = "; "
        .Execute Replace:=wdReplaceAll
    End With
    Set oRng = oTmp.Paragraphs(1).Range
    oRng.End = oRng.End - 3
    FixList = oRng.Text
    oTmp.Close 0
lbl_Exit:
    Set oRng = Nothing
    Set oPara = Nothing
    Exit Function
End Function