Dateien mittels Makro importieren

[John Doe]

Hallo liebe Excel-Community,
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 ;) Vielen lieben Dank schon jetzt für eure Rückmeldungen

lg JD





MAKRO:

Code:

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

[Elex]

Hi,

schau dich mal im Netz nach "power query mehrere excel dateien zusammenführen" um. (z.B. bei youtube)

Gruß Elex

[John Doe]

Hallo Elex,
das mit power query ist leider nicht möglich... da das Programm großteils mit summewenns arbeitet und ich auch die Einzelinformationen brauche, die über eine Gruppierung mittels Power query "verloren" gehen würde und ich die Einzeldateien wieder öffnen müsste...

lg JD

[Elex]

Hi

Deine Antwort im Bezug auf PQ ist nicht ganz zutreffend, aber auch nicht so wichtig.

Wenn es VBA sein soll, versuch mal den Code.

PHP-Code:

Sub import()
Dim Quelle As Workbook, QPfad As String, QDaName As String
Dim Zielblatt As String, Zielzeile As String
Dim AnzDatei As Long, j As Long

On Error Resume Next
Application.ScreenUpdating = False

With Sheets("Importliste")
  QPfad = .Range("F7").Value
  AnzDatei = .Cells(.Rows.Count, 1).End(xlUp).Row
  
  For j = 2 To AnzDatei
    Zielblatt = .Cells(j, 2).Value
    Zielzeile = .Cells(j, 3).Value
    Sheets(Zielblatt).Cells(1).CurrentRegion.Offset(Zielzeile - 1).Clear
    QDaName = .Cells(j, 1).Value
    Set Quelle = GetObject(QPfad & QDaName)
    Quelle.Worksheets(1).Range("a1").CurrentRegion.Offset(1).Copy Sheets(Zielblatt).Cells(Zielzeile, 1)
    Quelle.Close False
  Next j
End With

Set Quelle = Nothing
Application.ScreenUpdating = True
End Sub 


Gruß Elex

[steve1da]

Hola,

längst gelöst....

https://www.herber.de/forum/archiv/1752t...tm#1753467

Gruß,
steve1da