try
Sub test()
    Dim a, i As Long, b(), x As Long, n As Long, m As Object
    With Range("a1").CurrentRegion
        a = .Value
        txt = Join$(Application.Transpose(.Columns(1).Value))
        With CreateObject("VBScript.RegExp")
            .Global = True
            .Pattern = "[^,&-:;]+"
            x = .Execute(txt).Count * 2
            ReDim b(1 To UBound(a, 1) + x, 1 To UBound(a, 2))
            For i = 1 To UBound(a, 1)
                If .test(a(i, 1)) Then
                    For Each m In .Execute(a(i, 1))
                        n = n + 1
                        For ii = 1 To UBound(a, 2)
                            b(n, ii) = a(i, ii)
                        Next
                        b(n, 1) = Trim$(m.Value)
                    Next
                End If
            Next
        End With
        .Resize(n).Value = b
    End With
End Sub