Sub DatenSeparieren()
Dim lngCurrent As Long
Dim lngIndex As Long
Dim lngRow As Long
Dim lngLast As Long
Dim strSource As String
Dim strTarget As String
Dim strProduct As String
Dim strType() As String
' Tabellennamen...
strSource = "Quelle"
strTarget = "Ziel"
' Letzte Zeile...
lngLast = ThisWorkbook.Worksheets(strSource) _
.Cells(Rows.Count, 1).End(xlUp).Row
' Reset...
lngCurrent = 2
' Durchlaufen...
With ThisWorkbook.Worksheets(strSource)
For lngRow = 2 To lngLast
strProduct = Trim(.Cells(lngRow, 1).Value)
strType = Split(Trim(.Cells(lngRow, 2).Value), ",")
' Schreiben...
For lngIndex = LBound(strType) To UBound(strType)
If Len(Trim(strType(lngIndex))) > 0 Then
ThisWorkbook.Worksheets(strTarget) _
.Cells(lngCurrent, 1).Value = strProduct
ThisWorkbook.Worksheets(strTarget) _
.Cells(lngCurrent, 2).Value = Trim(strType(lngIndex))
lngCurrent = lngCurrent + 1
End If
Next
Next
End With
End Sub