Hallo Nicole! Die Beschreibung hat ein paar Fragen aufgeworfen. Die Umbrüche sind in Spalte A und B (bei dir Zeile 1 und 2).  Da ich bei dem Beispiel nicht ganz klar kommen. Du hast also in

Zeile 1 in der Zelle A1 einen Eintrag mit 2 Zeilen und in B1 mit 3 Zeilen,

in Zeile 2 in A2 einen Eintrag mit 2 Zeilen, B2 mit einem Eintrag

usw. .

Das Programm soll dann alle INhalt auf die darunterliegen Werte aufteilen. Ist die Reihenfolg dabei egal oder sollen  die ursp. Einträge aus Spalte A und B in der selben Zeile beginnen.  Das würde mit meinem Beispiel dann so sein:

von Zeile 1 bis 3 sind dann die Werte aus der alten Zeile 1 , wobei A3 leer ist, da A1 nr 2 zeilig war.

Ab Zeile 4 kommen dann die Werte aus der alten Zeile 2  (wobei hier dann B5 leer wäre ) usw.

Wenn das so sein soll, geht der Code. Probiere mal bitte ob das so wie gewünscht war.

Option Explicit

Sub aufteilen()
Dim zeil1 As Long   'Anzahlen Zeilen in Spalte A
Dim zeil2 As Long   'Anzahlen Zeilen in Spalte B
Dim anzahl As Long  ' Zeilen je Zelle von Spalte A
Dim anzahl2 As Long ' Zeile je Zelle von Spalte B
Dim a As Long       ' zum Zählen
Dim b As Long       ' zum Zählen
Dim zellzeil1       ' Zellinhalte der Zellen von Spalte A
Dim zellzeil2       ' Zellinhalte der Zellen von Spalte B

Application.ScreenUpdating = False
'Einträge in Spalte A und B suchen
zeil1 = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
zeil2 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

'größten Wert suchen
If zeil1 < zeil2 Then
    anzahl = zeil2
Else
    anzahl = zeil1
End If

'durch alle Zeilen durchgehen
For a = anzahl To 1 Step -1
    'Inhalt der gerade aktuellen Zelle such und nach "Zeilenumbruch" aufsplitten
    zellzeil1 = Split(ActiveSheet.Cells(a, 1), vbLf)
    zellzeil2 = Split(ActiveSheet.Cells(a, 2), vbLf)
    
    'prüfen Welche Zelle (aus Spalte A oder B) mehr Umbrüche hatte
    If UBound(zellzeil1) < UBound(zellzeil2) Then
        anzahl2 = UBound(zellzeil2)
    Else
        anzahl2 = UBound(zellzeil1)
    End If
    
    'je Umbruch Zeile einfügen und den jeweiligen Textteil eintragen
    For b = anzahl2 - 1 To 0 Step -1
        ActiveSheet.Cells(a + 1, 1).EntireRow.Insert Shift:=xlUp
        If UBound(zellzeil1) >= b + 1 Then Cells(a + 1, 1) = zellzeil1(b + 1)
        If UBound(zellzeil2) >= b + 1 Then Cells(a + 1, 2) = zellzeil2(b + 1)
    Next b
    
    'jetzt Ausgangszelle mit erstem Teil vom Inhalt beschreiben
    If UBound(zellzeil1) >= 0 Then Cells(a, 1) = zellzeil1(0)
    If UBound(zellzeil2) >= 0 Then Cells(a, 2) = zellzeil2(0)
   
Next a

Application.ScreenUpdating = True
End Sub