Office: Ausgewählte Zeilen *.txt in Excel importieren und zuordnen

Hallo Experten,

hoffe Ihr hattet ebenso schöne Weihnachtsfeiertage :)

Ärger mich allerdings seit gestern mit einem kleinen Makro rum...
Komm einfach ned klar damit.

Vielleicht könnt Ihr mir weiterhelfen.

Ich benötige ein Makro, das mir aus einer großen *.txt Datei mit ca. 4 Spalten und einigen tausend Zeilen diejenigen Zeilen nach Excel importiert, die zum jeweiligen Tabelleblattnamen passen.

Z.B.:

*.txt Datei:

Haus 1982 Januar 01
Garage 2000 November 03
Garten 1990 März 20
Garage 1920 Dezember 23
Garage 1999 Januar 22
...
...

Excelfile:

Tabellenblatt 1 = "Haus"
Tabellenblatt 2 = "Garten
Tabellenblatt 3 = "Garage"

Nun sollen die jeweiligen passenden Zeilen in die Tabellenblätter kopiert werden.

=>
Tabellenblatt 1 = "Haus"
Haus 1982 Januar 01
...

Tabellenblatt 2 = "Garten
Garten 1990 März 20
...

Tabellenblatt 3 = "Garage"
Garage 2000 November 03
Garage 1920 Dezember 23
Garage 1999 Januar 22
...


Sie anschließende Auswertung ist dann kein Problem mehr für mich...
aber mit diesem Schritt komm ich nicht klar.

Wär super, wenn Ihr mir etwas weiterhelfen könntet. Leider ist die Datei zu groß (Länge mehrere Tabellenblätter) um das Kopieren erst in Excel zu machen!

Viele Grüße und schönen Nachmittag noch.

Friedl

 

Anbei noch die beiden Beispiel Dateien...

 

Hi Friedl,

Code:

Sub TextdateiAuslesen()
    Dim strText As String
    Dim loText As Long
    Dim loZeileHaus As Long
    Dim loZeileGarten As Long
    Dim loZeileGarage As Long
    loZeileHaus = 1
    loZeileGarten = 1
    loZeileGarage = 1
    Open "C:\Test\Daten_roh.txt" For Input As #1  ' Pfad anpassen
    Do While Not EOF(1)
        Line Input #1, strText
        If InStr(strText, "Haus") > 0 Then
            Worksheets("Haus").Cells(loZeileHaus, 1) = strText
            loZeileHaus = loZeileHaus + 1
        ElseIf InStr(strText, "Garten") > 0 Then
            Worksheets("Garten").Cells(loZeileGarten, 1) = strText
            loZeileGarten = loZeileGarten + 1
        ElseIf InStr(strText, "Garage") > 0 Then
            Worksheets("Garage").Cells(loZeileGarage, 1) = strText
            loZeileGarage = loZeileGarage + 1
        End If
        loText = loText + 1
    Loop
    Close #1
End Sub

Bis später,
Karin