Datenimport aus verschiedener txt-files

Hallo, habe das Problem, dass ich von allen .txt-Dateien eines Ordners den kompletten Inhalt in ein Tabellenblatt importieren möchte, um damit weiterzuarbeiten.
Also d.h. den Inhalt der ersten Datei importieren ab Zelle A3,
nach dem Inhalt der ersten Datei, 2-3 Leerzeilen,
darunter der Inhalt von Datei 2,
usw. bis datei 108 (die 65536 verfügbaren Zeilen reichen locker aus.)
hab hier mal den Code zum Import der ersten Datei


Sub Makro2()
' Makro2 Makro
With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\1\G-1.txt", _
Destination:=ActiveCell)
.Name = "G-1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = True
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

Dieser Code zum Öffnender Datein, den ich hier im Forum fand, funktioniert gut, erstelt aber für jede Textdatei ein eigenees Tabellenblatt. Ich bräuchte aber den Inhalt aller txt-files auf einem Tabellenblatt, um mit Filter arbeiten zu können.


Sub Alle_Textdateien()
strExt = "*.txt"       'Dateiextension ggf. anpassen
ZuÖffnendeDatei = Application.GetOpenFilename("Textdateien (" & strExt & "), " & strExt,  _
Title:="Verzeichnisauswahl, erste Datei auswählen")
If ZuÖffnendeDatei = False Then Exit Sub
'Die ausgewählte Datei ist egal. es wird hier nur das Verzeichnis der Datei ausgewertet
strPath = CurDir & "\"
If strPath = "" Then
Exit Sub
Else
ChDir strPath
strFile = Dir(strPath & strExt) 'hier wird die erste Datei gefunden
Do While Len(strFile) > 0
Workbooks.OpenText Filename:=strPath & strFile, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, _
Tab:=True, Semicolon:=False, Comma:=False, _
Space:=True, Other:=False, trailingMinusNumbers:=True
Sheets(1).Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'...weiter mit Änderungen an der Tabelle
strFile = Dir() ' nächste Datei
Loop
End If
End Sub

wäre schön, wenn jemand Rat weiß

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Sub Alle_Textdateien() Dim strExt As String, strPath As String, strFile As String Dim ZuÖffnendeDatei Dim wb As Workbook, wksZiel As Worksheet Dim rngDaten As Range, lngZeile As Long strExt = "*.txt" 'Dateiextension ggf. anpassen ZuÖffnendeDatei = Application.GetOpenFilename("Textdateien (" & strExt & "), " & strExt, _ Title:="Verzeichnisauswahl, erste Datei auswählen") If ZuÖffnendeDatei = False Then Exit Sub 'Die ausgewählte Datei ist egal. es wird hier nur das Verzeichnis der Datei ausgewertet strPath = CurDir & "\" If strPath = "" Then Exit Sub Else ChDir strPath strFile = Dir(strPath & strExt) 'hier wird die erste Datei gefunden 'Leeres Tabellenblatt einfügen und als Ziel-Tabelle festlegen ThisWorkbook.Worksheets.Add _ After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) Set wksZiel = ActiveSheet lngZeile = 3 '1. Zeile ab der Daten in Zieltabelel eingefügt werden sollen Application.ScreenUpdating = False Do While Len(strFile) > 0 Workbooks.OpenText Filename:=strPath & strFile, DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, _ Tab:=True, Semicolon:=False, Comma:=False, _ Space:=True, Other:=False, trailingMinusNumbers:=True Set wb = ActiveWorkbook Set rngDaten = wb.Worksheets(1).UsedRange rngDaten.Copy Destination:=wksZiel.Cells(lngZeile, 1) lngZeile = lngZeile + rngDaten.Rows.Count + 2 '2 =Anzahl Leerzeilen zwischen _ Dateien wb.Close savechanges:=False strFile = Dir() ' nächste Datei Loop Application.ScreenUpdating = True MsgBox "Fertig" End If End Sub

Beliebteste Forumthreads (12 Monate)

Datenimport aus verschiedener txt-files

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Datenimport aus verschiedener txt-files

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread