Liste einer .txt-Datei nach Trennung aufteilen

Hallo liebe Community,
ich arbeite täglich mit Excel und schreibe auch selber in VBA. Jedoch stoße ich mit meiner neusten Baustelle an meine Grenzen und hoffe auch Hilfe von eurer Seite.
Das Sheet sieht folgendermaßen aus:
Die Daten werden aus einer .txt-Datei eingespielt, heißt per Trennzeichen in die einzelnen Spalten aufgeteilt. In der ersten Spalte steht jeweils ein Platzhalter für den Inhalt, der in der Zeile folgt - hiervon gibt es zwei: 1 und 2
Das Problem ist, dass in diesem einem Sheet beide Inhaltee aufeinander folgen, also z.B. Spalte A2:A77 hat den Inhalt 1 und A79:A230. Dazwischen stehen die Überschriften der neuen Liste.
Mein Ziel ist es erstmal diese beiden Listen mithilfe eines Makros in zwei verschiedene Arbeitsblätter zu verfrachten. Die Anzahl der Spalten mit dem Platzhalter 1 und 2 sind variabel, weswegen ich nicht einfach schreiben kann, dass er immer die Zeilen 2-77 in ein Abrietsblatt kopieren soll und mit den anderen parallel.
Wie schaffe ich es also, dass das Makro jede einzelne Zeile durchsucht und dann, je nachdem welcher Platzhalter in der ersten Zelle (A) steht, die Inhalt in zwei Arbeitsblätter aufteilt?
Vielen Dank schonmal im Voraus für eure Antworten.
Liebe Grüße
Pascal
Hier eine Beispieldatei, wie sie nach dem Öffnen der .txt-Datei aussieht
https://www.herber.de/bbs/user/87481.xls

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub Kopieren() Dim Platzhalter Dim intRow As Integer Dim lngLZeile As Long Dim i As Integer lngLZeile = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row intRow = 1 Do Until intRow > lngLZeile Platzhalter = Cells(intRow, 1).Value Select Case Platzhalter Case 1 With Worksheets("Tabelle1") Worksheets(1).Rows(intRow).Copy Destination:=.Rows(.Cells(Rows.Count, 1).End( _ xlUp).Row + 1) End With Case 2 With Worksheets("Tabelle2") Worksheets(1).Rows(intRow).Copy Destination:=.Rows(.Cells(Rows.Count, 1).End( _ xlUp).Row + 1) End With End Select intRow = intRow + 1 Loop End Sub

Sub TextTeilen() Dim TB0, TB1, TB2 Dim Z, LR&, T2& On Error GoTo Fehler Set TB0 = ActiveSheet Set TB1 = Sheets("Tabelle1") Set TB2 = Sheets("Tabelle2") LR = TB0.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte Application.ScreenUpdating = False 'Finden Zahl 2 Set Z = Columns("A:A").Find(What:="2", LookIn:=xlValues, LookAt _ :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase _ :=False, SearchFormat:=False) If Z Is Nothing Then MsgBox "Kein Teil 2 gefunden" Exit Sub End If T2 = Z.Row 'Reset TB1.Cells.Clear TB2.Cells.Clear 'Teile copieren TB0.Rows("1:" & T2 - 2).Copy TB1.Range("A1") TB0.Rows(T2 - 1 & ":" & LR).Copy TB2.Range("A1") Err.Clear Fehler: If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear End Sub

Beliebteste Forumthreads (12 Monate)

Liste einer .txt-Datei nach Trennung aufteilen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Liste einer .txt-Datei nach Trennung aufteilen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread