Sub Trennen()
Dim Textfolge As String
Dim TB1, TB2
Dim Zahl() As String
Dim L As Integer, LR As Integer
Dim x As Integer
Application.ScreenUpdating = False
Set TB1 = Worksheets("LF1 - 3.3 Linienlasten")
Set TB2 = Worksheets("Makro1")
L = TB1.Cells(TB1.Rows.Count, 1).End(xlUp).Row
For x = 4 To L
Textfolge = TB1.Cells(x, 3).Value
If Textfolge <> "" Then
LR = TB2.Cells(TB2.Rows.Count, 1).End(xlUp).Row
Zahl = Split(Textfolge, ",")
TB2.Cells(LR + 1, 1).Resize(UBound(Zahl) + 1, 1).Value = WorksheetFunction.Transpose(Zahl)
End If
Next x
Application.ScreenUpdating = True
End Sub