Zellwerte aus mehreren Dateien per VBA

[Philipp1344]

Hallo zusammen,

ich stehe vor folgendem Problem:

Ich habe verschiedene Angebote (jeweils eigene xlsx), die sich jeweils aus div. Kostenbausteinen zusammensetzen. Diese Kostenbausteine will ich in einem Tabellenblatt (neue Datei) miteinander vergleichen).

Die Krux an der Sache:
Ich habe pro Lieferant und Sachnummer eine eigene xlsx. In meiner Vergleichsdatei, soll dann jede Sachnummer auf einem separaten Tabellenblatt verglichen werden.
Die Quelldateien liegen alle im gleichen Laufwerksordner ab und haben alle den exakt gleichen Aufbau.

Ich benötige also ein Makro, dass
- die entsprechenden Werte aus den Quelldateien in meine Vergleichsübersicht einpflegt
- dabei die Zuordnung von Lieferant (Sowohl Lft-Name als auch -Nummer sind in der Quelldatei in einer entsprechenden Zelle - G9, bzw. G10 - eingetragen) und Sachnummer (soll in Vergleichsdatei als Tabellenblattname erscheinen und steht in Quelldatei in Zelle C9) beachtet
- die Anzahl der Lieferanten und Sachnummern ist nicht festgelegt, kann jedoch begrenzt werden, wenn notwendig (aufgrund Rechenleistung etc)
- idealerweise lassen sich die Dateien, deren Daten eingepflegt werden soll, in einem Userform im Explorer suchen und einfügen, andernfalls soll das Makro automatisch in dem Ordner suchen, wo das Makro liegt und alle Dateien darin einpflegen (Button hierfür bekomme ich selbst hin)

Beispiel:
Datei: Angebot_Lieferant1_Sachnummer1
Werte die verglichen, bzw in Vergleichsdatei kopiert werden sollen:E24, E29, E31, E38, E44, ...
in Vergleichsdatei (Tabellenblattname = Sachnummer): D10, D15, D17, D24, D30, ... (Beginnt in anderer Zelle, dann aber in gleicher Zählweise, bzw. Sprüngen "nach unten" wie in Quelldatei)

Datei: Angebot_Lieferant2:Sachnummer1
soll dann exakt gleich in Vergleichsdatei eingefügt werden, jedoch in Spalte H (immer 4 Spalten weiter rechts)

und so weiter... 

Und dann das gleiche im nächsten Tabellenblatt (nächste Sachnummer) ...

Das war sehr ausführlich beschrieben, ich hoffe einer von euch kann mir helfen. Wenn noch Angaben fehlen oder sonstige Fragen bestehen, einfach melden. Ich hoffe es ist klar, was ich brauche

Vielen Dank vorab!!
Philipp

[MisterBurns]

Crossposting
http://www.herber.de/forum/messages/1652087.html

[Philipp1344]

Sorry...nicht gewusst. Mea culpa!

[schauan]

Hallo Phillipp,

hast DU schon mal überlegt, die Daten per PowerQuery zu übernehmen?

[Steffl]

Hallo,

mal als ungetesteter Ansatz ohne Berücksichtigung der Einträge, weil ich hier keine Ausleselogik erkennen konnte und die Dateien dürfen nicht im selben Verzeichnis wie die Vergleichsdatei liegen.

Code:

Sub prcX()
   Dim strDatei As String, strLieferant As String, strSachnummer As String
  
   On Error Resume Next
   'im Unterverzeichnis Dateien bitte anpassen
   strDatei = Dir(ThisWorkbook.Path & "\Dateien\*.xls*")
   Do While strDatei <> ""
      Workbooks.Open ThisWorkbook.Path & "\Dateien\" & strDatei
      strLieferant = Split(strDatei, "_")(1)
      strSachnummer = Split(strDatei, "_")(2)
      strSachnummer = Left(strSachnummer, InStr(1, strSachnummer, ".") - 1)
      MsgBox "Die Sachnummer " & strSachnummer & " von dem Lieferanten " & _
      strLieferant & " existiert " & IIf(WorkSheetExists(strSachnummer), "", "nicht ") _
      & " als Tabellenblatt."
      ActiveWorkbook.Close False
      strDatei = Dir()
   Loop
End Sub
Public Function WorkSheetExists(ByVal strName As String) As Boolean
   On Error Resume Next
   WorkSheetExists = Not ThisWorkbook.Worksheets(strName) Is Nothing
End Function

[Philipp1344]

Hi Andre, mit PowerQuery kenne ich mich leider (noch) nicht aus - daher nein :(

[Philipp1344]

Hallo Stefan,

danke für deinen Code. Funktioniert leider nicht, bzw. es passiert schlicht gar nichts. Habe mein Quellverzeichnis (wo die Dateien Liegen die eingelesen werden sollen) eingefügt und deinen Code einem Button zugewiesen...

Grüße Philipp

[Steffl]

Hallo,

dann kommentiere mal die On Error Resume Next-Zeile aus.

[Philipp1344]

"Datei nicht gefunden."

Habe auch mal zum Test den exakten Pfad zu einer exakten Testdatei genutzt...
Du schreibst du die Dateien dürfen nicht im gleichen Verzeichnis liegen? - Ich nehme an damit meinst du das "letzte" Verzeichnis im Pfad?

Struktur sieht so aus:
... Überordner >> Vergleichsdatei.xlsm
                     >> Angebotsordner        >> Angebot 1.xls*
                                                         >> Angebot 2.xls*
                                                         >> Angebot n.xls*

[Steffl]

Hallo Philipp,

die Ordnerstruktur passt soweit. Das Du den Pfad zweimal anpassen musst, hast Du schon gesehen? In deinem Eingangsthread hast Du die Dateinamen mit zwei Unterstrichen angegeben, jetzt scheint es nicht mehr der Fall zu sein. Darauf bezieht sich aber mein Codevorschlag.