Option Explicit
Sub Tust()
Dim rngD As Range, rngA As Range, rngC As Range, rngZ As Range
Dim Txt As Variant, arrTxt() As String, a As Integer
Dim Flag As Integer
With Workbooks(2).Sheets(1).Columns(4)
Set rngD = .ColumnDifferences(.Cells(.Cells.Count))
For Each rngA In rngD.Areas
For Each rngC In rngA.Cells
Txt = rngC.Value
Flag = -1
If Len(rngC.Offset(, 11).Text) = "" Then Flag = 0
If Flag = -1 And InStr(rngC.Offset(, 11).Text, ",") = 0 Then Flag = 1
If Flag = -1 And InStr(rngC.Offset(, 11).Text, ",") >= 0 Then Flag = 2
If Flag = 2 Then arrTxt = Split(rngC.Offset(, 11).Text, ",")
With Workbooks(1).Sheets(1).Columns(1)
On Error Resume Next
Select Case Flag
Case 0
Set rngZ = .Cells(.Cells.Count).End(xlUp)(2)
rngZ.Value = rngC.Value
Case 1
Set rngZ = .Cells(.Cells.Count).End(xlUp)(2)
rngZ.Value = rngC.Value
If rngC.Offset(, 1).Value <> "Ilo" Then _
rngZ.Offset(, 1).Value = rngC.Offset(, 11).Text
Case 2
For a = LBound(arrTxt) To UBound(arrTxt)
If rngC.Offset(, 1).Value <> "Ilo" Then
Set rngZ = .Cells(.Cells.Count).End(xlUp)(2)
rngZ.Value = rngC.Value
rngZ.Offset(, 1).Value = arrTxt(a)
End If
Next a
End Select
If Flag = -1 Or Err.Number <> 0 Then _
Call MsgBox("schon wieder was vergessen", vbInformation, "LOL")
On Error GoTo 0
End With
Next rngC
Next rngA
End With
End Sub