Option Explicit


Sub Tust()
'ging einfacher & unleserlicher auch noch  LOL - aber
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
'wir bleiben dabei, dass die Reihenfolge der geöffneten Mappen so stimmt
' erst Mappe1, dann Mappe2
   With Workbooks(2).Sheets(1).Columns(4)
      'nur die Zellen in D wo Inhalt
      Set rngD = .ColumnDifferences(.Cells(.Cells.Count))
      'das ist womöglich ein Flickerteppich daher
      For Each rngA In rngD.Areas
         'erst über jeden Fleck
         For Each rngC In rngA.Cells
            'darin jede Zelle - erst den Spalte D - Wert
            'und was rchts von liegt mit .Offset(,Spalte[n])
            Txt = rngC.Value
            'Spalte O prüfen
            Flag = -1
            'nix drin
            If Len(rngC.Offset(, 11).Text) = "" Then Flag = 0
            'kein Trennzeichen - Komma
            If Flag = -1 And InStr(rngC.Offset(, 11).Text, ",") = 0 Then Flag = 1
            'doch ein Trennzeichen - Komma
            If Flag = -1 And InStr(rngC.Offset(, 11).Text, ",") >= 0 Then Flag = 2
            'aha, jetzt mach ein Array draus
            If Flag = 2 Then arrTxt = Split(rngC.Offset(, 11).Text, ",")
            'im Ziel
            With Workbooks(1).Sheets(1).Columns(1)
               'könnt ja doch ein Fehler aufkeimen
               On Error Resume Next
               'Flag auswerten
               Select Case Flag
                  Case 0
                     'kein O - Wert
                     'und immer schön die nächte, freie Zelle
                     Set rngZ = .Cells(.Cells.Count).End(xlUp)(2)
                     rngZ.Value = rngC.Value
                  Case 1
                     'doch ein O - Wert
                     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
                     'hatte Komma, daher über das Array
                     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