Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Mehrere Textdateien in ein Tabellenblatt kopieren

Mehrere Textdateien in ein Tabellenblatt kopieren
16.02.2017 12:03:30
Franny
Hallo zusammen,
danke erstmal an alle, die hier ausgiebig den Nutzern helfen.
Kommen wir direkt zu meinem Anliegen, ich würde gerne aus mehreren Textdateien innerhalb eines Ordners Daten entnehmen. Die einzelnen Textdateien sind immer gleich aufgebaut und enthalten viele Werte, die nicht notwendig sind.
Für eine einzelne Datei habe ich folgendes Makro per Aufzeichnung erfolgreich erstellt, hier könnte man eventuell noch hinzufügen, dass nur die erste Zeile hinzufügeft werden soll, der Rest ist nicht notwendig.
Sub TextEinlesen()
Application.WindowState = xlMaximized
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;x.txt", Destination:=Range("$A$1" _
))
.Name = "A38_32374"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(9, 1, 9, 5, 5, 9)
.TextFileFixedColumnWidths = Array(2, 8, 90, 8, 8)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Ich habe auch ein passendes Makro dazu gefunden mehrere Textdateien untereinander einzulesen, leider kann ich es nicht für meine Zwecke anpassen.
Folgendes Makro:
Sub DateienEinlesen()
x = Sheets(1).UsedRange.Rows.Count
d = Dir("O:\Test\*.txt")
Do While d  ""
Open "O:\Test\" & d For Input As #1
Do While Not EOF(1)
Line Input #1, temp
Cells(x, 1) = Replace(temp, vbTab, ";")
x = x + 1
Loop
Close #1
d = Dir
Loop
Sheets(1).UsedRange.Columns.AutoFit
End Sub

Was ich nun gerne hätte, um es auf den Punkt zu bringen:
Ich drücke auf einen Knopf (verbunden mit dem Makro), dabei erstellt sich ein neues Tabellenblatt, öffnet alle Textdateien innerhalb eines Ordners, kopiert nur jeweils die erste Zeile (+ Kriterien aus der oberen Aufzeichnung) und kopiert den Dateinamen in Zeile D.
Mal ein Beispiel:
http://i.imgur.com/8BquMYg.png
So sollte es dann bei 3 Dateien aussehen.
Danke euch für die Hilfe und es wäre super klasse, wenn ihr mir kleine Erklärungen zukommen lassen könnt, damit ich das besser verstehen kann, da ich in Zukunft hoffentlich ein wenig zurückgeben kann an die Community, wenn sich meine VBA Kenntnisse verbessert haben.
VG

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mehrere Textdateien in ein Tabellenblatt kopieren
18.02.2017 09:12:14
fcs
Hallo Franny,
hier das Makro zum Einlesen mehrerer Dateien.
LG
Franz
Sub DateienEinlesen()
Dim wks As Worksheet
Dim strPfad As String
Dim temp As String
Dim d As String
Dim x As Long
strPfad = "O:\Test\"
strPfad = "C:\Users\Public\Test\Temp\"
d = Dir(strPfad & "*.txt")
ActiveWorkbook.Worksheets.Add After:=ActiveWorkbook.Sheets(1)
x = 0
Set wks = ActiveSheet
Do While d  ""
Open strPfad & d For Input As #1
Line Input #1, temp
With wks
x = x + 1
.Cells(x, 1) = Mid(temp, 3, 8)
.Cells(x, 2) = CDate(Mid(temp, 101, 8))
.Cells(x, 3) = CDate(Mid(temp, 109, 8))
.Cells(x, 4) = d
End With
Close #1
d = Dir
Loop
Sheets(1).UsedRange.Columns.AutoFit
End Sub

Anzeige
AW: Mehrere Textdateien in ein Tabellenblatt kopieren
23.02.2017 14:20:51
Franny
Leider nicht ganz das, was ich gesucht hatte, bedanke mich trotzdem. Ich habe selber schon eine Lösung, aber ich bin noch nicht 100% zufrieden damit.

317 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige