Option Explicit

Private Const CH = ";"

Sub SplitSelection()
    SplitRange Selection
End Sub

Private Sub SplitRange(rn As Range)
    Dim Application_Calculation  As XlCalculation
    Application_Calculation = Application.Calculation
    Application.Calculation = xlCalculationManual

    Set rn = Intersect(rn, rn.Parent.UsedRange)
    Dim arr As Variant
    Dim ya As Long
    Dim cl As Range
    For Each cl In rn.Cells
        If InStr(cl.Value, CH) > 0 Then
            arr = Split(cl.Value, CH)
            For ya = UBound(arr) To LBound(arr) + 1 Step -1
                cl.EntireRow.Copy
                cl.EntireRow.Rows(2).Insert
                cl.Cells(2, 1).Value = Trim(arr(ya))
            Next
            cl.Value = Trim(arr(ya))

        End If
    Next
    Application.CutCopyMode = False
    Application.Calculation = Application_Calculation
End Sub