Hallo
Sorry, das mit den Textdateien ist mir durch die Lappen gegangen :-(
Ich hatte mit XLS Dateien probiert.
Sub Dateien_in_eine_Tabelle_zusammenfuehren()
Dim Datei As String
Dim Arbeitsmappe As String
Dim tarWb As Workbook, tarwks As Worksheet
Dim PFAD As String
PFAD = "C:\"
Datei = Dir(PFAD & "*.txt")
'Aktuell geöffnete Mappe
Set tarWb = Workbooks(ThisWorkbook.Name)
'Wo die Daten hinsollen
Set tarwks = tarWb.Worksheets("Tabelle1")
Application.ScreenUpdating = False
Arbeitsmappe = ActiveWorkbook.Name
Do While Datei <> ""
Call Read_Extern_File(PFAD & Datei)
'Schreibt in die nächste freie Zelle von "tarWks"
'H21 ist die Zelle wo der Wert ausgelesen werden soll
tarwks.Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = tarValue
Datei = Dir()
Loop
Application.ScreenUpdating = True
End Sub
Sub Read_Extern_File(ReadFile As String)
'Hilfsvariable für Anzahl Datensätze
Dim Text1 As String
'Variablen für den Array nötig
Dim txtlines As Long, i As Long
'Für Office97 muss das Array TextArr als String definiert werden
'Entdeckt duch Gerd Z aus dem Herber Forum
Dim textArr As Variant
'Schliessen einer geöffneten Datei
Close #1
'1. Öffnen der Datei
'Den Namen und Pfad bitte anpassen
Open ReadFile For Input As #1
'Die anzahl ist nötig um die Grösse des Arrays zu deklarieren
'Zähler auf 0 setzen
txtlines = 0
Do While Not EOF(1) ' Schleife bis Dateiende.
Line Input #1, Text1 ' Hilfsvariable zum einlesen verwenden
'Zähler hochzählen
txtlines = txtlines + 1
Loop
'Schliessen der Datei weil Dateiende erreicht wurde
Close #1
'Erneutes Öffnen um zum Dateianfang zu kommen
'Datei zum Einlesen öffnen.
Open ReadFile For Input As #1
'Array neu auf die Anzahl der Linien initialisieren
'Könnte man auch einfacher lösen,
'auf die Schnelle geht es aber
ReDim textArr(txtlines)
For i = 1 To txtlines
Input #1, textArr(i)
Next i
'Wert aus Zeile 21 nehmen
tarValue = textArr(21)
Close #1
End Sub
Gruss Rainer
