Daten auslesen .. Verzeichnis

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub sbZeile56() Dim lstrFile As String, liRow As Integer lstrFile = Dir("DeinPfad\*.xls") 'Pfad + Endung anpassen, da du es hier nicht angegeben _ hast If lstrFile = "" Then Exit Sub liRow = 1 Do Until lstrFile = "" Workbooks.Open "DeinPfad\" & lstrFile With ThisWorkBook(1) '1 anpassen, wenn neue Daten nicht in Tabelle1 sollen 'DeineTabelle = den Tabellennamen, aus der die Werte kommen .Cells(liRow, 1).Value = Sheets("DeineTabelle").Range("B1").Value .Cells(liRow, 2).Value = Sheets("DeineTabelle").Range("D2").Value .Cells(liRow, 3).Value = Sheets("DeineTabelle").Range("F1").Value .Cells(liRow, 4).Value = Sheets("DeineTabelle").Range("H1").Value '...usw bis... 'für DeineZelle56 = die letzte Zelle, die du übertragen willst .Cells(liRow, 56).Value = Sheets("DeineTabelle").Range("DeineZelle56"). _ Value End With lstrFile = Dir liRow = liRow + 1 Loop End Sub

Hi Mike
Sorry, das es etwas dauerte - aber ich hab ja auch noch n anderes Leben, außer Excel :-)
Hier nun meine Änderung:
https://www.herber.de/bbs/user/85179.zip
Wie du erkennen kannst, handelt es sich erst mal um ein ZIP-Archiv.
Wichtig!
Du musst das Archiv zuerst entpacken, bevor es losgeht.
Also nicht einfach doppelt auf die ZIP-Datei klicken und dann die Datei Uebersicht starten, sondern erst entpacken.
Danach existiert dann ein neues Unterverzeichnis mit 3 Dateien.
Wie die Dateien heißen, ist egal, da nach Start alle xls-Dateien gesucht + verarbeitet werden.
Mein Code schließt aber die Datei "Uebersicht" von der Verarbeitung aus, da diese Datei ja den Code enthält.
So, nun zu der Übersicht.
Ich hab nur den Code so weit angepasst, dass er auch funktioniert.
Wenn du also nach Entpacken des Archivs die Datei "uebersicht.xlsm" startest und nach Aktivierung der Makros das Makro "RadsatzDaten_importieren" gestartet hast, werden nacheinander alle xls*-Dateien geöffnet, und die entsprechenden Werte in die Uebersichtsdatei übertragen. Nach jedem Vorgang wird die gerade geöffnete Datei wieder geschlossen, und die nächste Datei wird geöffnet.
Achte darauf, dass du im Code vor dem Start erst mal wieder den Pfad anpassen musst, in dem die Dateien gespeichert sind.
So, und wenn nun auch bei dir zumindest erst mal die 2 Testdateien korrekt eingelesen wurden, kannst du ja die Codezeilen erweitern, damit auch alle noch fehlenden Werte übertragen werden.
Bin neugierig auf dein Feedback, ob nun alles läuft.
Ciao
Thorsten

Sub xxxx() Dim sFile As String, arr(1 To 1, 1 To 56) Dim wkb As Workbook Const sPath As String = "c:\test\" sFile = Dir(sPath & "*.xls*") Do While sFile "" Set wkb = Workbooks.Open(sPath & sFile) With wkb With .Sheets(1) arr(1, 1) = .Range("B1") arr(1, 2) = .Range("D2") arr(1, 3) = .Range("F1") arr(1, 4) = .Range("H1") 'etc End With .Close False End With Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 56) = arr Loop End Sub

Beliebteste Forumthreads (12 Monate)

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread