Sub BATATA()
Dim rng As Range
Dim r As Long
Dim arrParts() As String
Dim partNum As Long
'## In my example i use columns A:E, and column D contains the Corresponding Parts ##
'## Modify as needed ##'

Set rng = Range("A2:V3747")
r = 2
Do While r <= rng.Rows.Count
    '## Split the value in column BB (54) by commas, store in array ##
    arrParts = Split(rng(r, 3).Value, ";")
    '## If there's more than one item in the array, add new lines ##
    If UBound(arrParts) >= 1 Then '## corrected this logic for base 0 array
        rng(r, 3).Value = arrParts(0)

        '## Iterate over the items in the array ##
        For partNum = 1 To UBound(arrParts)
            '## Insert a new row ##'
            '## increment the row counter variable ##
            r = r + 1
            rng.Rows(r).Insert Shift:=xlDown

            '## Copy the row above ##'
            rng.Rows(r).Value = rng.Rows(r - 1).Value

            '## update the part number in the new row ##'
            rng(r, 3).Value = Trim(arrParts(partNum))

            '## resize our range variable as needed ##
            Set rng = rng.Resize(rng.Rows.Count + 1, rng.Columns.Count)

        Next

    End If
'## increment the row counter variable ##
r = r + 1
Loop

End Sub