Office 2016 txt-Dateien in Excel importieren per Makro

[Huhu]

Hallo Zusammen,

ich bin noch ein ziemlicher Anfänger was das Erstellen von Makros in Excel angeht und hoffe hier auf ein bischen Unterstützung.

Zu meinem Problem:

Ich habe mehrere 100 txt-Dateien die ich in Excel importieren möchte. Ich habe mal ein Makro aufgezeichnet was schon fast meine Anforderungen erfüllt.
Die Datei wird importiert, anhand der Trennzeichen die Tabelle erstellt, die nicht benötigten Spalten werden herausgelöscht und die verbleibenden werden benannt. s.u.

Jetzt hätte ich gerne, dass ich ALLE Dateien welche sich in einem Verzeichnis befinden auswählen kann und diese automatisch nach u.a. Schema in eine Exceldatei importiert werden und für jede einzelne Datatei ein eigenes Arbeitsblatt angelegt wird, welches dann mit dem Original Dateinamen benannt wird.

Beim Import muss die *.txt durch Leerzeichen und Anführungszeichen getrennt werden (TextToColumns .Cells(1), Space:=True / TextToColumns .Cells(1), Other:=True, OtherChar:="""")

Wenn der Import durchgeführt ist müssen in jedem Sheet die Spalten (A:B:D:F:G:H:J:K:L:M:N:O:P) gelöscht werden, diese werden nicht benötigt.

Weitehin soll dann noch eine Überschriftenzeile für die 3 verbleibenen Spalten eingefügt werden: A1=Stueck, B1=Preis, C1=Art.Nr.


Anbei mal eine txt und eine xls als Veranschaulichung. Und das aufgezeichnete Makro...

Code: [Auswählen]

    Sub Makro1()
    '
    '
    '
        ChDir "D:\test"
        Workbooks.OpenText Filename:="D:\test\Test.txt", Origin:= _
            xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
            xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
            Comma:=False, Space:=True, Other:=True, OtherChar:="""", FieldInfo:= _
            Array(Array(1, 9), Array(2, 9), Array(3, 1), Array(4, 9), Array(5, 1), Array(6, 9), Array(7 _
            , 9), Array(8, 9), Array(9, 1), Array(10, 9), Array(11, 9), Array(12, 9), Array(13, 9), Array _
            (14, 9), Array(15, 9), Array(16, 9)), TrailingMinusNumbers:=True
        Rows("1:1").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("A1").Select
        ActiveCell.FormulaR1C1 = "Stueckzahl"
        Range("B1").Select
        ActiveCell.FormulaR1C1 = "Preis"
        Range("C1").Select
        ActiveCell.FormulaR1C1 = "Art.-Nr."
        Range("A1:C1").Select
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Columns("B:B").Select
        ActiveCell.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Find(What:=",", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Activate
        Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:="(", Replacement:=" ", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        With Selection
            .HorizontalAlignment = xlRight
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
    End Sub



[gmg-cc]

Nach Aussage des Crossposters ist sein Problem wohl schon gelöst, siehe Beitrag hier (sehr weit unten, über einem Beitrag).

[Huhu]

Nach Aussage des Crossposters ist sein Problem wohl schon gelöst, siehe Beitrag hier (sehr weit unten, über einem Beitrag).

Danke Günter, für deine Zeit die du für diesen Kommentar investiert hast.

Bitte den Thread Schließen - ist erledigt!