Option Explicit

Sub cuttingDates()
Application.ScreenUpdating = False

Dim iResult As Long
Dim sParts() As String
Dim textToSplit As String
Dim CountChrInString As String
Dim lastrow As Integer
Dim i As Integer
Dim j As Integer
Dim datePart As String
Dim x As Integer
Dim y As Integer
Dim productName As String
Dim newValue As String
Dim newValueTemp As String


lastrow = Cells(Rows.Count, 2).End(xlUp).Row
y = 2
For i = 2 To lastrow



    textToSplit = Cells(i, 2)
    sParts = Split(textToSplit, ";")

    iResult = UBound(sParts, 1)

    If (iResult = -1) Then
    iResult = 0
    End If

    CountChrInString = iResult

    x = 1

    For j = 1 To iResult

        datePart = Replace(Mid(Cells(i, 2), x, 9), ";", "")
        productName = Cells(i, 1)
'        newValueTemp = datePart & vbNewLine & productName
'        newValue = newValue & vbNewLine & newValueTemp
        Cells(y, 5) = productName
        Cells(y, 6) = datePart

        x = x + 9
        y = y + 1

    Next
'    Cells(i, 3) = Replace(newValue, ";", "")
'    newValue = ""
Next

Application.ScreenUpdating = True

End Sub