Werte aus Datei in Masterfile

Liebes Forum
Bin mal wieder an meine Grenzen was VBA anbelangt geraten.
Ich möchte ein Makro schreiben, welches mir aus einem Verzeichnis bei allen Dateien (.xlsx)einen oder mehrere Werte kopiert und in dem Masterfile am entsprechenden Ort nebeneinander einfügt.
Das Masterfile habe ich soweit programmiert, dass es mir aus dem Verzeichnis die Dateinamen zieht und auflistet und den Namen der Dateien korrekt in die Spalten aufteilt.
In den einzelnen Dateien (.xlsx) hat es immer einen oder mehrere sogenannte "CPK" Werte. Das ist eine gewöhnliche Zahl mit 2 Kommastellen. Die Zahl steht in jeder der Dateien immer eine Zelle rechts von dem Wort "CPK" die Position dieser Zelle ist immer unterschiedlich. Auch die Anzahl solcher CPK-Werte pro Datei kann variieren.
Mein erster Gedanke war es also den Code so zu formulieren, dass er in jeder Datei das Wort "CPK" sucht und dann den Wert in der Zelle rechts davon kopiert und im Masterfile an der entsprechenden Position einfügt. Wenn es mehrere dieser CPK-Werte in einer Datei hat, soll er ihn rechts neben dem ersten Wert auflisten.
Hier 2 Beispieldateien:
Masterfile https://www.herber.de/bbs/user/114149.xlsm
Datei mit CPK Wert(en) https://www.herber.de/bbs/user/114150.xlsx
Kennt jemand eine Lösung dafür?
Grüsse
Sandro

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Sandro

Sub Einlesen_Daten()
Dim wkbMaster As Workbook, wkbQuelle As Workbook
Dim wksMaster As Worksheet, wksQuelle As Worksheet
Dim strPfad As String, strDateiname As String
Dim lngIndexZeile As Long, lngLetzteZeile As Long
Dim ar As Variant
Application.ScreenUpdating = False
'strPfad = "I:\Q-Prüfer\Messprotokolle\FAK\Messprotokolle\"
strPfad = ThisWorkbook.Path & "\test\"
Set wkbMaster = ThisWorkbook
Set wksMaster = wkbMaster.Worksheets("Tabelle1")
strDateiname = Dir$(strPfad)
Do While strDateiname  ""
Set wkbQuelle = Workbooks.Open(strPfad & strDateiname)
Set wksQuelle = wkbQuelle.Worksheets(1)
ar = Split(wkbQuelle.Name, " ")
For lngIndexZeile = 8 To wksQuelle.Cells(Rows.Count, 8).End(xlUp).Row Step 22
lngLetzteZeile = wksMaster.Cells(Rows.Count, 1).End(xlUp).Row + 1
wksMaster.Cells(lngLetzteZeile, 1) = wkbQuelle.Name
wksMaster.Cells(lngLetzteZeile, 2) = ar(0)
wksMaster.Cells(lngLetzteZeile, 3) = ar(1)
wksMaster.Cells(lngLetzteZeile, 4) = Left(ar(2), Len(ar(2)) - 5)
wksMaster.Cells(lngLetzteZeile, 5) = wksQuelle.Cells(lngIndexZeile, 8)
Next lngIndexZeile
wkbQuelle.Close False
strDateiname = Dir$()
Loop
End Sub

cu
Chris

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread