Thema: Daten aus mehreren Dateien untereinander importieren

Hallo zusammen!

Ich habe 7 Dateien, die befinden sich alle in Verschiedenen Ordnern auf SharePoint. Ich muss die Daten aus einem bestimmten Tabellenblatt aus jeder der Import-Dateien ins Tabellenblatt in meiner Masterdatei untereinander zusammenführen.. ich würde natürlich am liebsten eine Schleife einbauen, wo die Dateinamen und Pfade aus einer Liste in Masterdatei abgefragt werden.
Die Daten in den Import-Dateien haben viele leere Zeilen unten nach den Datensätzen, da die Formeln drin sind und die Zeilen noch nicht ausgefüllt wurden. wenn ich also die Daten aus allen Import Dateien untereinander kopiere, habe ich dazwischen 6 mal Blöcke mit leeren Zeilen. Da habe ich noch keine Lösung.

Bis jetzt habe ich einen seeeeeeeeehr abgespeckten Code: und hier werden alle Importe in die einzelnen Tabellenblättern in meiner Master Datei importiert. Dann führe ich die manuell zusammen.

Das problem ist dass nicht mal dieser Code funktioniert: das makro kopiert meine Import ins falsche Tabellenblatt.

Kann mir bitte jemand helfen?? Ich bin Anfänger und komme alleine nicht klar...

Und noch eine Sache: wie antworte ich auf Nachrichten zu meinem Thread?? Das ist mein zweiter Post und ich habe bis jetzt diese Funktion nicht gefunden...

Vielen Dank
LG Lena

Application.DisplayAlerts = False

Workbooks.Open Filename:="G:\Verkauf\Pricing\Elena\Potentiale\Alle Teams\LFC_Nord.xlsb", ReadOnly:=True
Workbooks("LFC_Nord.xlsb").Sheets("Maßnahmenplan").Range("A1: Z5000").Copy
Workbooks("test_makro.xlsm").Sheets("LFC_Nord").Cells(1, 1).PasteSpecial xlPasteValues --> aus irgendeinem Grund werden die Daten dann ins Blatt "Steuerung" geschoben..
Workbooks("LFC_Nord.xlsb").Close
Workbooks("test_makro.xlsm").Sheets("Steuerung").Activate
Application.CutCopyMode = False

Workbooks.Open Filename:="G:\Verkauf\Pricing\Elena\Potentiale\Alle Teams\LFC_Süd.xlsb", ReadOnly:=True
Workbooks("LFC_Süd.xlsb").Sheets("Maßnahmenplan").Range("A1: Z5000").Copy
Workbooks("test_makro.xlsm").Sheets("LFC_Süd").Cells(1, 1).PasteSpecial xlPasteValues
Workbooks("LFC_Süd.xlsb").Close
Workbooks("test_makro.xlsm").Sheets("Steuerung").Activate
Application.CutCopyMode = False
Application.DisplayAlerts = True

Hallo,
eine Idee wäre, die Dateinamen mit Pfad untereinander in eine Spalte einer eigenen Tabelle Deiner Master-Arbeitsmappe zu schreiben und dazu in der Nachbarzelle jeder Datei zusätzlich den Tabellennamen incl. Bereich der zu importierenden Daten sowie in der nächsten Nachbarzelle den Namen der Zieltabelle aufzuführen.
Damit kannst Du dann eine Schleife erstellen, die nacheinder alle aufgeführten Dateien öffnet, die Daten kopiert und in die entsprechend benannte Zieltabelle der Master-Arbeitsmappe einfügt.

Gruß
Jochen

Hallo zusammen,

ganz andere Vorschlag: mit Power Query?
siehe: https://excelhero.de/power-query/power-query-ganz-einfach-erklaert
Zuerst Pkt 5) Daten aus gesamten Ordnern abfragen
damit baut man eine PQ-Funktion, die eine Dateiliste lädt,

dann die Quellliste aus https://www.herber.de/forum/messages/169030.xlsx in einer Tabelle umwandeln und in einer PQ-Abfrage anbinden, die dann als Quelle für die PQ-Funktion gilt.

Es würde so aussehen:
https://www.herber.de/bbs/user/169035.xlsx
(könnte leider nicht vollständig testen)

Aktualisierung mit Strg+Alt+F5 oder auf die Ergebnistabelle im Blatt "Konsolidierung" rechtsklicken und "aktualisieren" (oder Alt+F5)

Weniger Makro, weniger Stress.


VG
Yal

Danke für die Idee, das habe ich schon getestet..geht leider nicht wegen SharePoint.. und wir haben eine sehr langsame Internet Verbindung. Für mich ist es einfacher die Dateien runterzuladen und über Makro zu konsolidieren.

VG Lena

hallo Jochen,

die Idee ist toll..ich kriege es aber nicht hin. Nicht man mein Mini Makro funktioniert...

LG Elena

Hallo Elena,
erstelle eine Master-Arbeitsmappe mit den erforderlichen Tabellen zur Aufnahme der kopierten Daten sowie
einer Tabelle, welche nebeneinander in eigenen Spalten die Pfade, die Dateinamen und die Importbereiche enthält
und lade die Arbeitsmappe hier hoch.
Dann sehe ich (oder auch jemand anderer der hier aktiven Helfer) mal weiter.
Gruß
Jochen

Nun lade ich die Datei hoch!
https://www.herber.de/bbs/user/169017.xlsm

Hi Lena,

zumindest ich würd mir noch wünschen, dass du uns ebenso Beispieldateien mit diesen Dateinamen per Upload zeigst...

LFC_Nord.xlsb inklusive dem Blatt Maßnahmenplan und natürlich Bsp-Datenzeilen innerhalb der Blätter
LFC_Nord.xlsb inklusive dem Blatt Maßnahmenplan und natürlich Bsp-Datenzeilen innerhalb der Blätter
TeamA.xlsb inklusive dem Blatt Maßnahmenplan Kat 1 und natürlich Bsp-Datenzeilen innerhalb der Blätter
TeamB.xlsb inklusive dem Blatt Maßnahmenplan Kat 2 und natürlich Bsp-Datenzeilen innerhalb der Blätter
TeamC.xlsb inklusive dem Blatt Maßnahmenplan Kat 3 und natürlich Bsp-Datenzeilen innerhalb der Blätter
TeamD.xlsb inklusive dem Blatt Maßnahmenplan Kat 4 und natürlich Bsp-Datenzeilen innerhalb der Blätter
TeamE.xlsb inklusive dem Blatt Maßnahmenplan Kat 5 und natürlich Bsp-Datenzeilen innerhalb der Blätter

...oder wenigstens 3 dieser Dateien.

Denn so wie jetzt kennen wir nur das Ziel, wo alles hin soll, aber keine einzige Quelle, wo die Datenzeilen herkommen.
(aber wer weiß, nur ich frag bisher danach; vllt wissen andere ja eine Lösung ohne die fehlenden Quell-Bsp-Dateien)

Ciao
Thorsten

Hi,

ach so, noch ne Frage, die ich eben vergessen hatte:

Nach deiner Angabe A6:bis letzte ausgefüllte Zeite in SpalteA möchtest du wirklich jeweils nur Daten aus Spalte A haben, oder?

Ciao
Thorsten

Hi Thorsten,
so schwierig ist das ja nicht zu lösen, oder?
Und da Du vermutlich schon die Lösung zu 80 % fertig hast, bin ich raus, ok?
Gruß
Jochen

Hi Jochen,

ich hab noch gar nicht angefangen; warte noch auf die fehlenden Bsp-Dateien mit Bsp-Daten.

zu deiner anderen Frage:
Ich würde, wie gewollt, jeweils nur die Daten aus Spalte A übertragen.

Da ich aber nicht sicher bin, ob sie mit "A6:bis letzte ausgefüllte Zeite in SpalteA" wirklich nur Daten aus Spalte A meint; sie könnte auch gemeint haben "A6:D (oder was auch immer) bis letzte ausgefüllte Zeite in SpalteA - deswegen frag ich da lieber noch mal nach - denn aufgrund von VBA bescheiden kann es sein, dass Lena eine "Erweiterung" auf mehr Spalten als nur A allein nicht hinbekommt...aber ja - für uns! ist das nich schwer zu lösen ;-)

Ciao
Thorsten

Hallo Thorsten,

danke für deine Rückmeldung. Ich lade hier nochmal die Ziel-Datei und eine Quelle-Datei. Alle Quellen Dateien sind absolut identisch aufgebaut bis auf den Tabellenblatt-Namen.
Es geht nicht um eine Spalte A, sondern um eine Range A5:Px (x-ist die letzte ausgefüllte Zeile in der Spalte A)

Quelle (alle 7 Quellen sind gleich aufgebaut)
https://www.herber.de/bbs/user/169030.xlsx

Zieldatei:
https://www.herber.de/bbs/user/169026.xlsm

Danke für deine Mühe und Zeit!!!!
Wenn du noch irgendwas von mir brauchst - meld dich gerne!

LG Lena

och Lena, echt???? :-/

mehr Mühe glaubst du, musst du dir nicht machen???
ok, kein problem, ich werde mit - einer Quelldatei, in der in jeder Zelle der selbe Wert steht! - etwas so programmieren, dass diese eine Quelldatei auch in deiner Masterdatei dahin kommt wo soll....aber...wenn in jeder Zelle das selbe Wort steht, werde ich nicht..und kann ich auch nicht...ne Kontrolle einbauen, dass jeder Zellinhalt aus Quelle - auch wirklich - im Ziel dahin kam wo es hin soll

kann n bisschen dauern, vllt werd ich erst morgen fertig

Hallo Elena
da Thorsten ja noch nicht so richtig angefangen hatte (sorry Thorsten)
versuche ich es mal mit dem folgenden Code:

Option Explicit

Public Sub AlleNEUModul()

  

  Dim myMaster As Workbook

  Set myMaster = ThisWorkbook

  Dim mySource As Workbook

  Dim zielZeile As Long

  Dim d As Long

  

  Application.DisplayAlerts = False

  Application.ScreenUpdating = False

  

  With myMaster

  

    For d = 4 To .Sheets("Daten").Cells(4, 1).End(xlDown).Row

      zielZeile = .Sheets("Konsolidierung").Cells(Rows.Count, 1).End(xlUp).Row + 1

      Workbooks.Open .Sheets("Daten").Cells(d, 1), ReadOnly:=True

      Set mySource = ActiveWorkbook

      Sheets(1).Range("A5:P" & ActiveSheet.Cells(4, 1).End(xlDown).Row).Copy

        .Sheets("Konsolidierung").Paste _

          Destination:=myMaster.Sheets("Konsolidierung").Range("A" & zielZeile)

        .Sheets("Konsolidierung").Range("Q" & zielZeile) = Date

        .Sheets("Konsolidierung").Range("R" & zielZeile) = mySource.Name

      mySource.Close

    Next

    

  End With

  

  Application.DisplayAlerts = True

  Application.ScreenUpdating = True



End Sub

Gruß
Jochen

Hallo Jochen,

ich habe den Code getestet! Er funktioniert! Vielen lieben Dank!
Wie kann ich den Code so anpassen, dass er mir nur Werte aus jeder Datei kopiert?
Sheets("Maßnahmenplan").Range("A6:P" & ActiveSheet.Cells(4, 1).End(xlDown).Row).Copy
.Sheets("Konsolidierung").Paste _ hier irgendwas mit PasteValues???
Destination:=myMaster.Sheets("Konsolidierung").Range("A" & zielZeile)

VG Lena

Elena,

ich lade Dir mal die von mir angepasste Arbeitsmappe hoch, Basis war Deine Beispielmappe :
Die dort (Blatt Daten) aufgeführten Dateien hatte ich anhand der "LFC_Nord.xlsb" einfach mal in die weiteren aufgeführten Dateien kopiert.

https://www.herber.de/bbs/user/169056.xlsm

Darum also sieht das in der Konsolidierungstabelle für jede Datei immer gleich aus.
Das Makro holt aus den 7 Dateien jeweils den Bereich "A5:P" & die Letzte gefüllte Zeile, also z.B. 12 als Kopie ans Ende des Konsolidierungsblattes.

Der jeweils zu kopierende Bereich wir in dieser Zeile festgelegt:
Sheets(zielTable).Range("A5:P" & ActiveSheet.Cells(4, 1).End(xlDown).Row).Copy
Hier kannst Du Deinen Vorstellungen entsprechend Änderungen einbauen.
Die ausgeblendeten Makrozeilen mit "Sheets("Daten Test Jochen" hatte ich für meine Umgebung geändert.
Gruß
Jochen

Hallo Jochen,

vielen Dank, jetzt ist es noch besser und dynamischer geworden.
Allerdings habe ich noch keine Lösung wie ich die Daten aus den Quellen als Werte einfüge und nicht mit allem (Formate und Formel werden aktuell mitkopiert)

Wie soll ich richtig diese Zeile ergänzen, damit ich nur Werte kopiert bekommen?
.Sheets("Konsolidierung").Paste _

VG Lena

.PasteSpecial Paste:=xlValues

also so:

Option Explicit



Public Sub AlleNEUModul()

  

  Dim myMaster As Workbook

  Set myMaster = ThisWorkbook

  Dim mySource As Workbook

  Dim zielZeile As Long

  Dim zielTable As String

  Dim d As Long

  

  Application.DisplayAlerts = False

  Application.ScreenUpdating = False

  

  With myMaster

  

    'For d = 4 To .Sheets("Daten Test Jochen").Cells(4, 1).End(xlDown).Row

    For d = 4 To .Sheets("Daten").Cells(4, 1).End(xlDown).Row

      zielZeile = .Sheets("Konsolidierung").Cells(Rows.Count, 1).End(xlUp).Row + 1

      'zielTable = .Sheets("Daten Test Jochen").Cells(d, 2).Text

      zielTable = .Sheets("Daten").Cells(d, 2).Text

      'Workbooks.Open .Sheets("Daten Test Jochen").Cells(d, 1), ReadOnly:=True

      Workbooks.Open .Sheets("Daten").Cells(d, 1), ReadOnly:=True

      Set mySource = ActiveWorkbook

      Sheets(zielTable).Range("A5:P" & ActiveSheet.Cells(4, 1).End(xlDown).Row).Copy

      .Sheets("Konsolidierung").Range("A" & zielZeile).PasteSpecial Paste:=xlValues

      .Sheets("Konsolidierung").Range("Q" & zielZeile) = Date

      .Sheets("Konsolidierung").Range("R" & zielZeile) = mySource.Name

      mySource.Close

    Next

  End With

  

  Application.DisplayAlerts = True

  Application.ScreenUpdating = True



End Sub

Viel Erfolg!!!
Gruß
Jochen

Danke dir! Habe diesen Beitrag irgendwie übersehen :)

Ich habe ein neues Problem... das Makro findet jetzt die zu kopierenden Dateien nicht...

Workbooks.Open .Sheets("Daten").Cells(d, 1), ReadOnly:=True diese zeile wird gelb markiert.. ich habe den Pfad geprüft, die Dateinamen passen auch, die Dateien kann ich manuell öffnen.. hast du eine Idee warum es plötzlich nicht mehr funktioniert?

LG Elena

Public Sub Konsolidieren()

  

  Dim myMaster As Workbook

  Set myMaster = ThisWorkbook

  Dim mySource As Workbook

  Dim zielZeile As Long

  Dim zielTable As String

  Dim d As Long

  

  Application.DisplayAlerts = False

  Application.ScreenUpdating = False

  

  With myMaster

  

  

    For d = 4 To .Sheets("Daten").Cells(4, 1).End(xlDown).Row

      zielZeile = .Sheets("Konsolidierung").Cells(Rows.Count, 1).End(xlUp).Row + 1

      zielTable = .Sheets("Daten").Cells(d, 2).Text

      Workbooks.Open .Sheets("Daten").Cells(d, 1), ReadOnly:=True

      Set mySource = ActiveWorkbook

      Sheets(zielTable).Range("A5:P" & ActiveSheet.Cells(4, 3).End(xlDown).Row).Copy

      .Sheets("Konsolidierung").Range("A" & zielZeile).PasteSpecial Paste:=xlValues

      .Sheets("Konsolidierung").Range("Q" & zielZeile) = Date

      .Sheets("Konsolidierung").Range("R" & zielZeile) = mySource.Name

      mySource.Close

    Next

  End With

  

  Application.DisplayAlerts = True

  Application.ScreenUpdating = True



End Sub

so.. jetzt habe ich mich und alle hier verwirrt... sorry dafür! Alles funktioniert.
Habe aus Versehen eine leere Zeile eingefügt, daher wurden die Pfande nicht gefunden!

Funktioniert! Vielen Dank!

LG Lena

Hallo Jochen,

vielen lieben Dank!

VG Lena

Hallo Jochen,

habe ich diese Zeile an falscher Stelle eingefügt?
Die zwei Zeilen unten werden beim Einfügen von ".PasteSpecial Paste:=xlValues" rot markiert...

For d = 4 To .Sheets("Daten").Cells(4, 1).End(xlDown).Row
zielZeile = .Sheets("Konsolidierung").Cells(Rows.Count, 1).End(xlUp).Row + 1
zielTable = .Sheets("Daten").Cells(d, 2).Text
Workbooks.Open .Sheets("Daten").Cells(d, 1), ReadOnly:=True
Set mySource = ActiveWorkbook
Sheets(zielTable).Range("A5:P" & ActiveSheet.Cells(4, 3).End(xlDown).Row).Copy
.Sheets("Konsolidierung").PasteSpecial Paste:=xlValues _ --->der Teil wir rot markiert
Destination:=myMaster.Sheets("Konsolidierung").Range("A" & zielZeile)----> der Teil wir rot markiert
.Sheets("Konsolidierung").Range("Q" & zielZeile) = Date
.Sheets("Konsolidierung").Range("R" & zielZeile) = mySource.Name
mySource.Close
Next
End With

VG Lena

Hallo Elena,
entferne diesen Teil:

Sheets(zielTable).Range("A5:P" & ActiveSheet.Cells(4, 3).End(xlDown).Row).Copy

.Sheets("Konsolidierung").PasteSpecial Paste:=xlValues _ --->der Teil wir rot markiert

Destination:=myMaster.Sheets("Konsolidierung").Range("A" & zielZeile)----> der Teil wir rot markiert

und füge das ein:

Sheets(zielTable).Range("A5:P" & ActiveSheet.Cells(4, 1).End(xlDown).Row).Copy

.Sheets("Konsolidierung").Range("A" & zielZeile).PasteSpecial Paste:=xlValues

Gruß
Jochen

Hey Jochen, es funktioniert doch nicht ganz mit dem neuen Code..
Ich habe jetzt 2 Quelle-Dateien getestet.

Wenn ich den Code-Teil verwende, dann werden die Daten aus der ersten Quelle-Datei ins Tabellenblatt "Steuerung" als Werte reinkopiert (Blatt wo der Makro-Button ist) und die Daten aus der zweiten Quelle-Datei ins richtige Ziel-Tabellenblatt. Mit "Destination" vorher hat es aber funktioniert...

Hast du da eine Idee?
LG Lena

Public Sub Values()

Dim myMaster As Workbook

  Set myMaster = ThisWorkbook

  Dim mySource As Workbook

  Dim zielZeile As Long

  Dim zielTable As String

  Dim d As Long

  

  Application.DisplayAlerts = False

  Application.ScreenUpdating = False

  

  With myMaster

  

    

    For d = 4 To .Sheets("Daten").Cells(4, 1).End(xlDown).Row

      zielZeile = .Sheets("Konsolidierung").Cells(Rows.Count, 1).End(xlUp).Row + 1

      zielTable = .Sheets("Daten").Cells(d, 2).Text

      Workbooks.Open .Sheets("Daten").Cells(d, 1), ReadOnly:=True

      Set mySource = ActiveWorkbook

      Sheets(zielTable).Range("A5:P" & ActiveSheet.Cells(4, 1).End(xlDown).Row).Copy

        .Sheets("Konsolidierung").Range("A" & zielZeile).PasteSpecial Paste:=xlValues

        .Sheets("Konsolidierung").Range("Q" & zielZeile) = Date

        .Sheets("Konsolidierung").Range("R" & zielZeile) = mySource.Name

      mySource.Close

    Next

  End With

  

  Application.DisplayAlerts = True

  Application.ScreenUpdating = True



End Sub

Elena,

bei mir funktioniert dieser Code ohne Fehler:

Option Explicit



Public Sub Values()



  Dim myMaster As Workbook

  Set myMaster = ThisWorkbook

  Dim mySource As Workbook

  Dim zielZeile As Long

  Dim zielTable As String

  Dim d As Long

  

  Application.DisplayAlerts = False

  Application.ScreenUpdating = False

  

  With myMaster

    For d = 4 To .Sheets("Daten").Cells(4, 1).End(xlDown).Row

      zielZeile = .Sheets("Konsolidierung").Cells(Rows.Count, 1).End(xlUp).Row + 1

      zielTable = .Sheets("Daten").Cells(d, 2).Value

      Workbooks.Open .Sheets("Daten").Cells(d, 1), ReadOnly:=True

      Set mySource = ActiveWorkbook

      Sheets(zielTable).Range("A5:P" & ActiveSheet.Cells(4, 1).End(xlDown).Row).Copy

        .Sheets("Konsolidierung").Range("A" & zielZeile).PasteSpecial Paste:=xlValues

        .Sheets("Konsolidierung").Range("Q" & zielZeile) = Date

        .Sheets("Konsolidierung").Range("R" & zielZeile) = mySource.Name

      mySource.Close

    Next

  End With

  

  Application.DisplayAlerts = True

  Application.ScreenUpdating = True



End Sub

so siehts im Blatt "Daten" aus:


Jochen

Hallo Jochen.

ich habe hin und her getestet, irgendwas ist komisch... bei mir werden statt Werte auch die Formeln mitkopiert...:( ich weiß nicht mehr weiter...
Würdest du dir bitte meine Dateien anschauen?
Ich habe jetzt einmal meine Master-Datei mit dem Code angehängt (der code ist nocmal hier unten) und 2 Quelle-Dateien.

MasterDatei https://www.herber.de/bbs/user/169311.xlsm


Quelle1 https://www.herber.de/bbs/user/169314.xlsx

Quelle2 https://www.herber.de/bbs/user/169313.xlsx

Vielen Dank!!
VG Lena

Option Explicit

Public Sub IMPORT()

Dim myMaster As Workbook

  Set myMaster = ThisWorkbook

  Dim mySource As Workbook

  Dim zielZeile As Long

  Dim zielTable As String

  Dim d As Long

  

  Application.DisplayAlerts = False

  Application.ScreenUpdating = False

  

  With myMaster

  

   

    For d = 4 To .Sheets("Daten").Cells(4, 2).End(xlDown).Row

      zielZeile = .Sheets("Konsolidierung").Cells(Rows.Count, 1).End(xlUp).Row + 1

      zielTable = .Sheets("Daten").Cells(d, 3).Text

      Workbooks.Open .Sheets("Daten").Cells(d, 2), ReadOnly:=True

      Set mySource = ActiveWorkbook

      Sheets(zielTable).Range("A6:Q3000").Copy

      .Sheets("Konsolidierung").Range("A" & zielZeile).PasteSpecial Paste:=xlValue

      Application.CutCopyMode = False

      mySource.Close

      myMaster.Sheets("Daten").Cells(d, 4).Value = Format(Now, "YYYY.MM.DD hh:mm ")

      myMaster.Sheets("Daten").Cells(d, 5) = Environ("username")

    Next

  End With

  

  Application.DisplayAlerts = True

  Application.ScreenUpdating = True



End Sub

Hallo Elena,

der Fehler ist in dieser Zeile deiens Codes:

      Sheets(zielTable).Range("A6:Q3000").Copy

      .Sheets("Konsolidierung").Range("A" & zielZeile).PasteSpecial Paste:=xlValue

ein kleiner aber folgenschwerer Fehler: es heißt "Paste;=xlValues !!! mit dem 's' am Ende !!!
also so:

      Sheets(zielTable).Range("A6:Q3000").Copy

      .Sheets("Konsolidierung").Range("A" & zielZeile).PasteSpecial Paste:=xlValues

Gruß
Jochen

Hallo

Beispiel Datei mit Überschrift nur A gibt für mich keinen Sinn
Ich Denke dies ist ohne VBA mit PQ lösbar.

Mit PQ habe ich schon probiert, es funktioniert halbwegs.. wegen interner Probleme.. die Daten befinden sich auf ShatePoint.. weenn ich PQ aktualisiere dauert es ewig und dann bleibt hängen, weil die Internetverbindung bei meinem Arbeitsgeber nicht die beste ist... Deswegen werde ich die Dateien vom SharePoint manuell runterladen und über Makro konsolidieren...

LG Lena

ja, Thorsten hat Recht, bitte lies nochmal komplett was ich Dir geschrieben hatte.