Sub CreateDataDistribution
  Call CreateDataDistribution("Sheet1","Sheet2")
End Sub

Sub createDataDistribution(shtBefore as String, shtAfter as String)

Dim mycell as Range
Dim mydiffs as Integer
Dim currSer as String
Dim compSer as String
Dim currSer2 as String
Dim compSer2 as String
Dim outputI as Integer
Dim identityInsert as Integer
Dim FoundV as Boolean
Dim FoundV2 as Boolean

outputI = 1
identityInsert = 1

For Each mycell in ActiveWorkbook.Worksheets(shtBefore).UsedRange

  If mycell.Column = 2 Then
    currSer = ActiveWorkbook.Worksheets(shtBefore).Cells(mycell.Row,2).Value
    
    If Trim(currSer) <> "" Then

      Dim headends() as String
      headends = Split(Trim(currSer), ",")

      Dim i as Integer

      for i = 0 to UBound(headends)

        If Trim(headends(i)) <> "" Then

          ActiveWorkbook.Worksheets(shtAfter).Cells(outputI,1).Value = ActiveWorkbook.Worksheets(shtBefore).Cells(mycell.Row,1).Value
          ActiveWorkbook.Worksheets(shtAfter).Cells(outputI,2).Value = Trim(headends(i))
          
          outputI = outputI + 1

        End If
      Next
    End If

  End If

End Sub