Spalten von mehreren Exceldateien in einer Gesamtdatei auflisten

Spalten von mehreren Exceldateien in einer Gesamtdatei auflisten (mit autom. aktualisierung der Werte)


Hallo liebe Profis ,

ich habe ein Problem an dem ich schon eine ganze Weile verzweifle. Eine erste Lösung habe ich nun schon in diesem Forum gefunden (siehe Code unten). Bräuchte aber noch ein paar Verfeinerungen...

Das Problem ist folgendes:
Ich habe Timesheetdateien von ca. 30 Mitarbeitern (Excel Datei mit jeweils einem Sheet pro Monate in dem pro Tag und Aufgabe die Stunden eingegeben werden können. Diese werden hier dann schon als Wochenwerte aufsummiert. Ausserdem gibt es ein Dropdownmenue in dem die Tasks ausgewählt werden und die automatisch andere Zellen befüllen). Aus diesen Dateien möchte ich Teile (die Aufgaben und die Wochenwerte) in einer Sammeldatei untereinander aufführen (inklusive der Formatierungen), um eine Übersicht zu haben. Diese sollte sich beim Öffnen immer automatisch aktualisieren, wenn es in den Einzeldateien Änderungen gegeben hat (ich möchte jede Woche die aktualisierten Dateien der Mitarbeiter in dem Sammelsheet ansehen).
Mit dem unten stehenden Code kann ich nun schon die Daten aus den verschiedenen Dateien in einer Auflisten, solange die beiden Sheets genau die gleiche Struktur haben und ich alle Spalten übernehme.

Ich arbeite in den Timesheets mit definierten Namen und Dropdownmenues sowie etlichen Formeln.
Das Problem bei der bisherigen Lösung (Code unten) ist, dass ich immer eine Meldung bekomme, in der ich den Bereichsnamen umbenennen muss, damit die Daten übernommen werden. Kann dies irgendwie umgangen werden?

Und diese Lösung funktioniert auch nur, wenn die zusammenfassende Datei exakt die gleiche Struktur hat wie die einzelnen...
Ich möchte aber ganz gerne nur bestimmte Spalten aus den einzelnen Dateien rüberziehen (Beispiel: in den Einzelsheet können Stunden pro Tag eingegeben werden, die dann wochenweise aufsummiert werden. In der Sammeldatei hätte ich gerne nur die Wochenwerte...)
Und es werden auch aus jeder Datei aus jedem Sheet die Überschriften wieder übernommen, die ich auch gerne rauslassen würde.
Ist das auch irgendwie möglich?

Und das dritte Problem ist, wie gesagt, dass die Daten nicht automatisch aktualisiert werden, wenn ich in den Einzeldateien etwas ändere.
Hier kann ich höchsten jede Woche dann ein neues Sammelsheet machen...

Ich habe leider so gut wie gar keine Ahnung von VBA und wäre für jede Hilfe dankbar.



Viele Grüße,


gefundener Code/bisherige Lösung:

Option Explicit

Sub Sammle()
Const sSourcePath As String = "D:\Viele viele XLS"
Dim wbGes As Workbook, wsTarget As Worksheet
Dim wbTeil As Workbook, wsSource As Worksheet
Dim fso As Object, oFile As Object
Dim rNext As Integer, bSheetFound As Boolean
Set wbGes = ActiveWorkbook
Set fso = CreateObject("Scripting.FileSystemObject")

'Quell-Ordner durchsuchen
For Each oFile In fso.GetFolder(sSourcePath).Files
'nur .xls-Dateien bearbeiten
If LCase(Right(oFile.Name, 4)) = ".xls" Then
Application.Workbooks.Open (oFile.Path)
Set wbTeil = ActiveWorkbook
'alle Tabellen der Gesamt-Datei bearbeiten
For Each wsTarget In wbGes.Worksheets
'Tabelle auch in Teil-Datei enthalten?
For Each wsSource In wbTeil.Worksheets
bSheetFound = False
If LCase(wsTarget.Name) = LCase(wsSource.Name) Then
bSheetFound = True
Exit For
End If
Next
If bSheetFound Then
'Tabelle da, Daten kopieren ...
wbTeil.Worksheets(wsTarget.Name).Activate
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Copy
'... und einfügen in Gesamt-Datei-Tabelle...
wbGes.Worksheets(wsTarget.Name).Activate
'... ab der nächsten freien Zeile
rNext = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
ActiveSheet.Cells(rNext, 1).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next 'Tabelle
wbTeil.Close
End If
Next 'Datei
wbGes.Worksheets(1).Activate
'Gesamt-Datei speichern
wbGes.Save
MsgBox "Fertig."
End Sub