Viele Excel Tabellen auslesen

Liebe VBA Profis,
nach langem Durchstöbern vieler Foren und Berichte bin ich nun leider doch gezwungen Hilfe in Anspruch zu nehmen.
Ich habe eine riesige Ordnerstruktur mit Kunden (Anfangsbuchstaben, Kunden, Unterordner usw.) und bei jedem Kunden gibt es ein Excel wo zum Abschluss des Projektes quasi eine Kostenrechnung vorliegt - Deckungsbeitrag.
Ich habe mir eine Batchdatei gemacht, die alle diese Excel (gleicher Aufbau, nur ein Tabellenblatt) aus dieser Struktur ermittelt und in einen eigenen Ordner kopiert.
Da liegen dann +1000 Excel drinnen und ich würde jetzt gerne diese Daten ins POWER BI holen.
Dazu würde ich gerne wöchentlich jedes Excel automatisch öffnen und bestimmte Zellwerte in eine "Masterarbeitsmappe" für den Export schreiben.
D.h. aus jedem Quell Exceltabellenblatt würde ich gerne einen Zeile mit ca. 10 Spalten im Masterexcel machen.
Hat von Euch jemand so etwas schon programmiert?
Pfade des Quellexcelordners und der Zieldatei kann auch hart im Coding stehen - kein Eingabefeld nötig.
Die Schleife für das Öffnen (ein Excel nach dem Anderen, Werte von x nach x übernehmen, wieder schließen, nächstes Excel) ist für mich nach einigen Versuchen leider nicht hinzubekommen. (habe auch keine Erfahrung sondern nur versucht aus diversen Quellen mir etwas "zusammenzustoppeln"
Wenn ich ein Muster hätte Zelle x nach Zelle x wäre ich sehr dankbar dafür.
Vielen Dank für Eure Unterstützung
Liebe Grüße Joachim

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub Alle_Dateien() Dim strDatei As String, wbQuelle As Workbook, wsZiel As Worksheet 'Pfad zu den Quelldateien anpassen, Backslash am Ende nicht vergessen Const FILE_PATH As String = "C:\Eigene Dateien\" Set wsZiel = ThisWorkbook.Worksheets("DeinZielblatt") strDatei = Dir$(FILE_PATH & "*.xlsx") Application.ScreenUpdating = False Do Until strDatei = "" Set wbQuelle = Workbooks.Open(Filename:=FILE_PATH & strDatei) 'Quellblatt und Zielblatt anpassen 'Kopierbereich anpassen wbQuelle.Sheets(1).Range("D1").EntireRow.Copy _ ThisWorkbook.Worksheets("Zielblatt").Cells(Cells(Rows.Count, "A").End(xlUp).Offset(1).Row, "A") wbQuelle.Close False strDatei = Dir$ Loop Set wsZiel = Nothing: Set wbQuelle = Nothing End Sub

Public Sub Alle_Dateien() Dim strDatei As String, wbQuelle As Workbook, wsZiel As Worksheet 'Pfad zu den Quelldateien anpassen, Backslash am Ende nicht vergessen Const FILE_PATH As String = "\\server\home\j.baader\TestLaufzettelA\" Set wsZiel = ThisWorkbook.Worksheets("Tabelle1") strDatei = Dir$(FILE_PATH & "*.xlsx") Application.ScreenUpdating = False Do Until strDatei = "" Set wbQuelle = Workbooks.Open(Filename:=FILE_PATH & strDatei) 'Quellblatt und Zielblatt anpassen 'Kopierbereich anpassen wbQuelle.Sheets(1).Range("B2").EntireRow.Copy _ ThisWorkbook.Worksheets("Tabelle1").Cells(Cells(Rows.Count, "A").End(xlUp).Offset(1).Row, "A") wbQuelle.Close False strDatei = Dir$ Loop Set wsZiel = Nothing: Set wbQuelle = Nothing End Sub

Hallo Joachim,
Werner ist wohl länger offline.


Public Sub Alle_Dateien()
Dim strDatei As String
Dim wbQuelle As Workbook
Dim wsZiel As Worksheet
Dim AktZeile As Long
'Pfad zu den Quelldateien anpassen, Backslash am Ende nicht vergessen
Const FILE_PATH As String = "\\server\home\j.baader\TestLaufzettelA\"
Set wsZiel = ThisWorkbook.Worksheets("Tabelle1")
strDatei = Dir$(FILE_PATH & "*.xlsx")
Application.ScreenUpdating = False
Do Until strDatei = ""
AktZeile = wsZiel.Cells(Rows.Count, "A").End(xlUp).Offset(1).Row
Set wbQuelle = Workbooks.Open(Filename:=FILE_PATH & strDatei)
'Quellblatt und Zielblatt anpassen
'Kopierbereich anpassen
wbQuelle.Sheets(1).Range("B2").Copy
wsZiel.Range("A" & AktZeile).PasteSpecial xlPasteValues
wbQuelle.Close False
strDatei = Dir$
Loop
Set wsZiel = Nothing: Set wbQuelle = Nothing
Application.ScreenUpdating = True
End Sub

In dem Block zwischen '---- ist das Lesen (hier B2) und Ablegen (hier Ax) der einzelne Wert. Dieses Block musst Du duplizieren und anpassen. x ist die aktuelle Zeile.
B2 zu Ax:
wbQuelle.Sheets(1).Range("B2").Copy
wsZiel.Range("A" & AktZeile).PasteSpecial xlPasteValues
C3 zu Bx:
wbQuelle.Sheets(1).Range("C3").Copy
wsZiel.Range("B" & AktZeile).PasteSpecial xlPasteValues
.. zu Cx usw
Stelle aber sicher, dass die Zelle, die in Spalte A abgelegt wird, IMMER befüllt ist. Sonst wird die nächste Zeile nicht richtig ermittelt und es geht schief.
Ich habe auf PasteSpecial xlPasteValues umgestellt, weil, wenn die Quelle eine Formel beinhaltet, will man den Wert und nicht die Formel (die dann in der Zieldatei nicht funktioniert).
VG
Yal

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread