ich habe nochmal eine Frage. In einer zentralen Übersichtsdatei sollen Tabellenausschnitte aus mehreren Excel Dateien (einzelne Regionen Deutschland) zusammengeführt werden. Zuvor löste ich das in einer Datei d.h. ein Übersichtssheet und mehrere Sheets für die einzelnen Regionen. Nun will ich dies aber ändern. Jede Region soll nun ein einzelnes Worksheet (extra Datei) sein und die Übersichtsdatei zieht die entsprechenden Informationen aus den einzelnen Dateien. Nun fällt es mir jedoch schwer den Code so umzuschreiben das dies funktioniert.
Weiterhin liegen alle Dateien in einem Ordner und der Ordner wird immer als ganzes verschoben. Deswegen würde ich das gerne so umsetzen, dass es keine konkreten Verzeichnisse angegeben werden müssen sondern alles auf diesen gemeinsamen Ordner verlinkt.
Folgende Lösung habe ich bisher. Hier wird jedoch nocht mit einem konkreten Verzeichnis gearbeitet und weiterhin funktioniert das ansprechen der Dateienen noch nicht.
Option Explicit
Sub Bayern()
Rem: Variablen deklarieren
Dim wsZiel As Worksheet
Dim wsQuelle As Worksheet
Dim lastCell As Long, lastColumn As Integer
Rem: Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False
'Zielblatt = aktive Datei, aktives Blatt
Set wsZiel = ActiveWorkbook.ActiveSheet
'Quellblatt = Datei, Blatt 1
Set wsQuelle = Workbooks.Open(Filename:="Verzeichnis\Bayern.xlsx").Worksheets(1)
Rem: letzte beschriebene Zeile in Tabellenblatt "Tabelle1" in Spalte A ermitteln
Rem: und in Variable "lastCell" schreiben
Rem: Stehen die Kundennummern in einer anderen Spalte, die Spaltenbezeichnung A
Rem: in der Range("A65536")- Anweisung ändern
lastCell = Workbooks("Bayern.xlsx").Worksheets("Bayern").Range("E65536").End(xlUp).Row
Rem: Den Bereich A1 bis letzte beschriebene Zelle und letzte beschriebene Zeile
Rem: (Bereichsende setzt sich aus den Variablen "lastColumn" und "lastCell" zusammen) kopieren _
_
und...
wsQuelle.Range(Cells(6, 1), Cells(lastCell, 10)).Copy
'Quelle schließen
wsQuelle.Parent.Close
Set wsQuelle = Nothing
Set wsZiel = Nothing
Rem: Einfügen in das Übersichtssheet aus der Übersichtsdatei
lastCell = Sheets("Übersicht").Range("B65536").End(xlUp).Row
Sheets("Übersicht").Cells(Sheets("Übersicht").Range("A65536").End(xlUp).Offset(lastCell - 1). _
Row, 1) _
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Übersicht").Cells(Sheets("Übersicht").Range("A65536").End(xlUp).Offset(lastCell - 1). _
Row, 1) _
.PasteSpecial Paste:=xlPasteValues
End Sub