Dateien mittels Makro importieren
19.04.2020 13:26:42
John
habe folgendes Problem und hoffe es kann mir jemand weiterhelfen, da ich schon kurz vorm verzweifeln bin ;)
Ausgangssituation:
Ich habe eine Excel-Hauptdatei (anbei eine abgespeckte Beispieldatei: TEST.xlsm) mit einem Tabellenblatt Importliste. Per Makro sollen nun aus einem definierten Hauptverzeichnis der Inhalt angeführten Dateien im Tabellenblatt Importliste (Spalte A --> die zu importierenden Dateien sind alle gleich aufgebaut und haben immer nur 1 Tabellenblatt mit Daten)) in definierte Tabellenblätter (Spalte B) ab einer gewissen Zeile (Spalte C) importiert werden. Zusätzlich sollen die vorhandenen Daten in den Tabellenblätter-bevor die neuen importiert- gelöscht werden.
Ich brauche deshalb eine Makro-Lösung, da täglich ca. 50 Einzeldateien in einem Ordner abgespeichert werden und aus diesen ein standardiesierter Bericht in der Excel Hauptdatei erzeugt wird.
Anbei habe ich eine entsprechende Test-Datei (TEST_V2.xlsm) mit Musteraufbau und Makro angefügt.
Leider weiß ich nicht was in meinem Makro nicht passt.
Ich hoffe ihr könnt mir weiterhelfen BIIIIITTTTEEEE ;)
MAKRO:
Sub IMPORTIERE()
'Das ist die Importtaste in der Tabelle IMPORTLISTE mit der alle Quelldateien ausgelesen und
'in die betreffenden Zieltabellen eingefügt werden
Dim DATEI As String 'Quelldateiname
Dim PFAD As String 'Quelldateipfad
Dim I As Long
Dim T As Integer
Dim s As Integer
Dim WERT
Dim ZIELTABELLE As String 'Name der Zieltabelle
Dim BEREICH As String 'der zu kopierende Zellbereich der Quelldatei
Dim SPALTE As Integer
Dim ZEILE As Integer
Dim ERSTEZEILE As Integer
Dim ZEILENDIFFERENZ As Integer 'wieviel höher die Zieltabellenzeilen sind als die _
Quelltabellenzeilen
Dim AKTUELLEDATEI
Dim LETZTEZELLE
'Quellpfad um \ erweitern
If Right(Sheets("Importliste").Range("F7"), 1) "\" Then Sheets("Importliste").Range("F7") = _
_
Sheets("Importliste").Range("F7") & "\"
'ChDrive (Left(Sheets("Importliste").Range("F7"), 1))
'ChDir (Sheets("Importliste").Range("F7"))
AKTUELLEDATEI = ActiveWorkbook.Name
On Error GoTo DATEI_NICHT_GEFUNDEN
'Schleife durch alle Dateien in der Tabelle IMPORTLISTE
For s = 2 To LETZTEZELLE(Worksheets("Importliste")).Row
PFAD = Sheets("Importliste").Range("F7")
DATEI = Sheets("Importliste").Range("A" & s).Text
ZIELTABELLE = Sheets("Importliste").Range("B" & s).Text
BEREICH = "A" & Sheets("Importliste").Range("B" & s) & ":IU60000"
ERSTEZEILE = Sheets("Importliste").Range("C" & s).Text
Sheets(ZIELTABELLE).Range("A1:IV65000").ClearContents
Application.ScreenUpdating = False 'Bild nicht aktualisieren
Workbooks.Open PFAD & DATEI
ZEILENDIFFERENZ = ERSTEZEILE - 1
For ZEILE = ERSTEZEILE To LETZTEZELLE(Workbooks(DATEI).Worksheets(1)).Row
For SPALTE = 1 To LETZTEZELLE(Workbooks(DATEI).Worksheets(1)).Column
Workbooks(AKTUELLEDATEI).Sheets(ZIELTABELLE).Cells(ZEILE - ZEILENDIFFERENZ, SPALTE) = _
Workbooks(DATEI).Worksheets(1).Cells(ZEILE, SPALTE)
Next SPALTE
Next ZEILE
Workbooks(DATEI).Close
Application.ScreenUpdating = True
Next s
Exit Sub
DATEI_NICHT_GEFUNDEN:
MsgBox "Die Datei " & DATEI & " konnte nicht im Verzeichnis " & PFAD & " gefunden werden." & _
_
vbCrLf & vbCrLf & _
"Stellen Sie sicher, dass die Datei im angegebenen Verzeichnis existiert oder ändern Sie die _
Einstellungen hier in der Tabelle Importliste."
End Sub