Sub a()
Dim i&, x&, y&, t
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
If InStr(Cells(i, "B"), ";") > 0 Then
t = Split(Cells(i, "B"), ";")
x = Cells(i, "B").Offset(1).Row
y = UBound(t)
Rows(x).Resize(y).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i, "B").Resize(y + 1) = Application.Transpose(t)
Cells(i, "A").Resize(y + 1).FillDown
Cells(i, "C").Resize(y + 1).FillDown
End If
Next
End Sub