Zelle Splitten

Sub splitCells()
Dim vntIn As Variant, vntOut() As Variant, vntTmp() As Variant, vntSplit As Variant, vntH As  _
Variant
Dim lngI As Long, lngJ As Long, lngN As Long, lngM As Long
With Sheets("Tabelle2") 'Ausgabgstabelle - Anpassen!
vntH = .Range("A2:F1")
vntIn = .Range("A2:F" & Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row))
End With
Redim vntTmp(1 To 1, 1 To UBound(vntIn, 2))
For lngI = 1 To UBound(vntIn, 1)
vntSplit = Split(vntIn(lngI, 6), ",")
For lngN = 0 To UBound(vntSplit)
For lngJ = 1 To UBound(vntIn, 2) - 1
vntTmp(1, lngJ) = vntIn(lngI, lngJ)
Next
vntTmp(1, UBound(vntTmp, 2)) = vntSplit(lngN)
lngM = lngM + 1
Redim Preserve vntOut(1 To lngM)
vntOut(lngM) = vntTmp
Next
Next
vntOut = Application.Transpose(Application.Transpose(vntOut))
Worksheets.Add
With ActiveSheet
.Columns(6).NumberFormat = "0"
.Range("A1").Resize(1, UBound(vntH, 2)) = vntH
.Range("A2").Resize(UBound(vntOut), UBound(vntOut, 2)) = vntOut
.Columns.AutoFit
End With
End Sub