Makro zum übernehmen von Zellen
04.06.2020 10:36:22
Zellen
Ich möchte ein Excel Datei erstellen die mir eine Übersicht über in einem Ordnerverzeichnis gespeicherte Dateien gibt. Nennen wir es einfach mal das "Masterdoc".
In diesem Masterdoc sollte wie Schaltfläche ein Makro aktiviert werden welches, alle in diesem Ordner befindlichen Dokumente automatisiert öffnet, mir ein paar wenige Daten (Zellen ausließt und ins Masterdoc kopiert. Danach sollten alle Dokumente in dem Ordner System natürlich wieder automatisiert geschlossen werden. Die Dokumente in dem Ordner System sind alle exakt gleich aufgebaut was das auslesen den endsprechenden Zellen relativ einfach machen sollte.
Mein bisheriger Ansatz sieht folgendermaßen aus:
Option Explicit
Sub Dateien_zusammenf?hren()
Dim Zielarbeitsmappe As Object
Dim Quellenarbeitsmappe As Object
Dim Pfad As String
Dim Datei As String
Dim x As Integer
Dim ws As Worksheet
Dim wb As Workbook
Application.ScreenUpdating = False ' Bildschirm flackert nicht
Application.DisplayAlerts = False ' keine ausgabe von Fehlermeldungen
Set Zielarbeitsmappe = ActiveWorkbook
Pfad = "C:\Beispielpfad\"
Datei = Dir(CStr(Pfad & "*xl*")) ' Code sucht nur nach Excel Dateien
Do While Datei "" 'Loop der sagt er soll solange Dateien suchen bis es keine mehr gibt
Set Quellenarbeitsmappe = Workbooks.Open(Pfad & Datei, False, True) 'Code öeffnet alle Files
Set wb = ThisWorkbook.Sheets(1)
Set ws = ActiveWorkbook.Sheets(3)
With ws
.Cells(2, 6) = wb.Cells(18, 2) 'Beispielwert Priorität
.Cells(2, 6) = wb.Cells(18, 2) 'Beispielwert Priorität
.Cells(2, 6) = wb.Cells(18, 2) 'Beispielwert Priorität
.Cells(2, 6) = wb.Cells(18, 2) 'Beispielwert Priorität
End With
Quellenarbeitsmappe.Sheets().Copy after:=Zielarbeitsmappe.Sheets(Zielarbeitsmappe.Sheets.Count) _
_
_
' Zeile, damit der Code nur das erste sheet kopiert
Zielarbeitsmappe.Sheets(Zielarbeitsmappe.Sheets.Count).Name = Datei 'Zeile, damit die Datei _
namen im Ordner gleich hei?en wie die integrierten Sheets
Quellenarbeitsmappe.Close 'Ausgewertete Datei im Zielordner schlie?en
Datei = Dir()
Loop 'das ganze wiederholen bis alle Dateien durch sind
Application.ScreenUpdating = True
Application.DisplayAlerts = True 'Flackern und Fehlermeldungen wieder aktiviert
MsgBox "Dateien wurden zusammengef?hrt"
Set Zielarbeitsmappe = Nothing
Set Quellenarbeitsmappe = Nothing ' Variablen wieder "aufr?umen"
End Sub
Das öffnen und schließen aller Datei klappt schon, nur eben das übernehmen nicht. (habe den Teil des Codes der mir als Fehler angezeigt wird und bei dem ich nicht verstehe wie ich es machen soll mit '!!!!!!!! markiert.
Oh wichtig wäre glaub noch, das es sich bei der Datei die auszulesen ist um das 3te. Sheet handelt mit dem Namen "Antrag". Im Masterdoc ist das Sheet in das die Infos gespeichert werden das erste Sheet.
Mit dem .Cells(x,x) Befehl erhoffe ich mir relativ flexibel hinterher bestimmen zu können welchen Teil der jeweiligen Datei ausgelesen werden soll.
Falls jemand eine Idee hat wie ich den letzten Step gehen könnte bin ich sehr dankbar.
Sollte ich noch was wichtiges vergessen haben reiche ich die Infos natürlich sofort nach ;-)
Beste Grüße
Bene