Datenübernahme funzt nicht

Hallo,
jetzt bin ich in der Tat verzweifelt...
Ich hatte bereits gestern mal einen Eintrag im Forum gemacht - leider muß ich mich wohl zu umständlich ausgedrückt haben - zumindest danke an Robert für die Meldung, die mich allerdings nicht weitergebracht hat.
Habe jetzt mal versucht, eine Makrolösung zu erarbeiten (folgt unten).
Ziel bleibt folgender Sachverhalt:
Ich habe ein UV mit diversen Exceldateien - alle gleichen Aufbaus aber unterschiedlichen Daten. Damit ich von den bisher genutzen Verknüpfungen in meiner Zieldatei wegkomme, will ich mir die Daten aus den jeweiligen Dateien einlesen und in einem "zentralen" Tabellenblatt meiner Zusammenfassungsdatei ablegen.
Folgendes Makro soll den Ordner nach XLS Dateien durchsuchen, diese öffnen und dann den Wert in den Ordner "gelesen" in Spalte A zusammenfassen. Doch leider greift das Ding noch nicht mal die Dateien an (öffnet Sie also nicht). Letzendlich will ich diese Schleife dann für jede im Verzeichnis gefundene XLS Datei durchlaufen... Wie geht das, bzw. wo ist das Ding hier falsch?

Sub Dateien_in_eine_Tabelle_zusammenfuehren2()
Dim Datei As String, Pfad As String
Dim objDatei As Workbook
Sheets("Werte").Select
ChDir Range("b3")
Pfad = Range("b3")
Datei = Dir$(Pfad & "*.xls")
'Application.ScreenUpdating = False
Do While Datei  ""
'Öffnet eine Datei
Set objDatei = Workbooks.Open(Datei, , True)
'Wert holen
With objDatei.Sheets("Tabelle1")
Range("g4").Select
Selection.Copy
Windows("tool.xls").Activate
Sheets("gelesen").Select
Cells(Range("A1").End(xlDown).Row + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
'Schliesst die geöffnete Datei
objDatei.Close False
'Prüft für die nächste Datei
Datei = Dir$()
Loop
Application.ScreenUpdating = True
End Sub

In diesem Fall sollte er das Feld G4 aus Tabelle1 in die Spalte A des Blatts "gelesen" übertragen. Macht er halt nicht. Könnt Ihr mir bitte einen Tipp geben und meine Makrounkenntnis verzeihen...?
Damit ich in der Schleife nicht jeden Wert zum Übertragen extra aufnehmen muß, abschließend noch folgende Frage: Geht es, dass ich im Blatt "Werte" meiner Datei Tool.xls in Spalte C und D die auszulesenden Tabellenblätter und Zellen aufführe und das Makro dies selbstständig mit übernimmt?
Hoffe auf Eure Unterstützung
Liebe Grüße
Ron
und hier noch mal die Datei: https://www.herber.de/bbs/user/64706.xls

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub Dateien_in_eine_Tabelle_zusammenfuehren2() Dim Datei As String, Pfad As String Dim objDatei As Workbook Dim myTB, myCell, myValue, myWB As String Dim ze As Integer ChDir Sheets("Werte").Range("b3") Pfad = Sheets("Werte").Range("b3") Datei = Dir$(Pfad & "\*.xls") myWB = ThisWorkbook.Name ze = 8 Do While Datei "" myTB = Sheets("Werte").Cells(ze, 3).Value myCell = Sheets("Werte").Cells(ze, 4).Value Set objDatei = Workbooks.Open(Datei, , True) myValue = objDatei.Sheets(myTB).Range(myCell).Value Workbooks(myWB).Sheets("gelesen").Cells(1, ze - 7) = myValue objDatei.Close False Datei = Dir$() ze = ze + 1 Loop Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread