Makro für alle Dateien eines Ordners ausführen

Hallo Masterminds!
Leider habe ich noch keinen passenden Beitrag gefunden und ich steh mit meinen Kenntnissen am Ende.
Ich versuche mein Problem so gut es geht zu veranschaulichen:
Ich habe einen Ordner c:\Regal1 und dieser enthält 300 Dateien Buch1.xlsm, Buch2.xlsm ect., die alle gleich aufgebaut sind, nur andere Werte enthalten.
Und es gibt einen zweiten Ordner c:\Regal2, der enthält auch 300 Dateien Schachtel1.xlsm, Schachtel2.xlsm ect.
In jeder Schachteldatei ist ein Pfad zu einer Buchdatei (Anmerkung: keine annähernd identen Dateinamen).
Außerdem hab ich ein Makro Bibliothekar, welches Daten (jedes Mal dieselben Zellen) aus der Buchdatei in die Schachteldatei kopiert.
Ich bin auf der Suche nach einem Makro Arbeitsanweisung, welches für jede Schachteldatei im Ordner c:\Regal2 das Makro Bibliothekar ausführen soll. Kann mir da jemand weiterhelfen?
Ich möchte vermeiden jedes Mal händisch die Schachteldatei zu öffnen, das Makro Bibliothekar hineinzukopieren und auszuführen, da das bei der Menge der Dateien leider ewig dauert und in Zukunft auch noch öfter vorkommen kann.
Das Makro Bibliothekar habe ich mir mit Hilfe zusammenbasteln können. Kann ich leider erst morgen früh hier reinkopieren.
Vielleicht hat ja schon wer einen Tipp! Ich bin für alles dankbar!
Liebe Grüße,
Susi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Danke, das mit ThisWorkbook und ActiveWorkbook war schon ein guter Tipp!
Mein "Bibliothekar" ist allerdings das hier:


Sub Bibliothekar()
Set main1 = ThisWorkbook.Sheets("Tabelle3") 'Schachteldatei
Set main2 = ThisWorkbook.Sheets("Tabelle1") 'Schachteldatei
Set wbbasis = Workbooks.Open(main1.Cells(1, 2).Value) 'Buchdateipfad in Schachtel
Set wsbasis1 = wbbasis.Sheets("Tabelle1") 'Buchdatei
wbbasis.IsAddin = True
main2.Unprotect Password:="123"
wsbasis1.Range("K9:K20").Copy 'Buch
main2.Range("K9:K20").PasteSpecial xlPasteFormulas 'Schachtel
main2.Protect Password:="123"
End Sub

So und daraus versuch ich das Makro "Arbeitsanweisung" zu machen:


Sub Arbeitsanweisung()
Dim strDatnam As String
Dim wb As Workbook
Dim strPfad As String
Dim main1 As String
strPfad = "C:\regal2\"
strDatnam = Dir(strPfad & "*.xlsm")
Do While strDatnam  ""
Set wb = Workbooks.Open(strPfad & strDatnam)
With Workbooks(strDatnam)
Set main1 = Workbooks(strDatnam).Sheets("Tabelle3")
Set main2 = Workbooks(strDatnam).Sheets("Tabelle1")
Set wbbasis = Workbooks.Open(main1.Cells(1, 2).Value)
Set wsbasis1 = wbbasis.Sheets("Tabelle1")
wbbasis.IsAddin = True
main2.Unprotect Password:="123"
wsbasis1.Range("K9:K20").Copy
main2.Range("K9:K20").PasteSpecial xlPasteFormulas
main2.Protect Password:="123"
End With
wb.Close savechanges:=True
strDatnam = Dir
Loop
Set wb = Nothing
End Sub

Bei set main1 hängt sichs auf. Wie sag ich ihm denn das richtig?
Danke!
Susi

Beliebteste Forumthreads (12 Monate)

Makro für alle Dateien eines Ordners ausführen

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

329 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro für alle Dateien eines Ordners ausführen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

329 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread