Hallo Liebe Leute,

ich wende mich mit einem kleinen Problem an euch. Ich habe eine Tabelle in dem ein Dateienkopf steht der durch Zeilenumbrüche unterteilt ist, vergleichbar mit einem Briefkopf:

Simon

Max Mustermann Straße 2

12345 Musterstadt

Ich möchte diesen "Briefkopf" in mehrere Spalten aufteilen. Das geht auch mit meinem Code recht gut und schön. Habe ich jedoch 2 "Briefköpfe" untereinander, also in A1 und dann in A2, teilt er den Kopf nicht mehr auf sobald ein Umbruch kommt sondern schreibt den Text einfach rein.

Sub Aufteilen()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.CutCopyMode = False

    Dim iSpaltealt, iSpalteneu As Integer
    Dim iZeile  As Integer
    Dim iPosit  As Integer

            iSpaltealt = 1
            iSpalteneu = 2
            iZeile = 1
        
            If Len(Range(Cells(iZeile, iSpaltealt), Cells(iZeile, iSpaltealt)).Value) = 0 Then
                iZeile = iZeile + 1
            Else
Aufteilen:
                For iPosit = 1 To Len(Range(Cells(iZeile, iSpaltealt), Cells(iZeile, iSpaltealt)).Value)
                    If Mid(Range(Cells(iSpaltealt, iZeile), Cells(iSpaltealt, iZeile)).Value, iPosit, 1) = Chr(10) Then
                        iSpalteneu = iSpalteneu + 1
                    Else
                        Range(Cells(iZeile, iSpalteneu), Cells(iZeile, iSpalteneu)).Value = Range(Cells(iZeile, iSpalteneu), Cells(iZeile, iSpalteneu)).Value & _
                        Mid(Range(Cells(iZeile, iSpaltealt), Cells(iZeile, iSpaltealt)).Value, iPosit, 1)
                    End If
                Next iPosit
            End If
            iZeile = iZeile + 1
            iSpalteneu = 2
            If Len(Range(Cells(iSpaltealt, iZeile), Cells(iSpaltealt, iZeile))) > 1 Then GoTo Aufteilen

End Sub

Könnt ihr mir hierbei helfen? Ich habe keine Ahnung warum er den Zeilenumbruch in den nachfolgenden Zellen ignoriert.

Vielen Dank im Voraus.

Gruß,

Simon