Makro zum auslesen verschiedener Datein

Hallo Excelspezialisten, ich stehe mal wieder vor einem Problem.
Es soll die Gesamtauslastung jedes Mitarbeiters ermittelt werden. Dafür habe ich für jedes Projekt eine Projektdatei mit einem Tabellenblatt in dem sämtliche Mitarbeiter aufgeführt sind und in dem man die Auslastung in diesem Projekt für die Dauer von sechs Monaten eintragen kann angelegt (siehe Beispieldatei).
https://www.herber.de/bbs/user/12764.xls
Alle Tabellenblätter in den Projektdateien sind gleich. Nun möchte ich in einer Gesamtdatei (gleicher Aufbau der Tabellen) die Stundenauslastung aller Mitarbeiter über alle Projekte aufsummieren.
Ich habe mir vorgestellt, ich werde ein Makro erstellen, das sämtliche in einem Verzeichnis befindliche Projektdateien öffnet, das Tabellenblatt herauskopiert und in die Gesamtdatei reinkopiert. Durch Bezüge würde ich dann die Auslastung im Gesamtverzeichnis aus allen Tabellenblättern aufsummieren.
Ich haben nun festgestellt das diese Aufgabe mit dem Makrorekorder nicht zu machen ist, da ich dabei nicht das automatische Öffnen aller Dateien nacheinander programmieren kann sondern das Auslesen einer Datei. Von Hand kann ich leider keine VBA-Programme schreiben das die Aufgabe erfüllt.
Könnte mir vielleicht jemand weiterhelfen, ich schaffe es nicht allein.
Viele Grüße von Basti.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Basti,
das hier kopiert eine bestimmte Range
aus allen Dateien eines Verzeichnisses
nacheinander in das aktive Blatt.
Du müßtest nur die Kopierprozedur
deinen Bedürfnissen anpassen.
FG
Rolf
Option Explicit
Dim WS As Worksheet
Const copyrange As String = "A1:D2"
'Startprozedur


Sub start_copy_pgm()
Const VerzDefault As Variant = "C:\arbeitsdateien"
Dim verz As String
Set WS = ActiveWorkbook.ActiveSheet
verz = Ordner_def(VerzDefault)
ChDir verz
Application.ScreenUpdating = False
ShowFileList (verz)
End Sub

'Excel-Dateien öffnen


Sub ShowFileList(folderspec)
Dim exapp As Object
Dim fs, f, fc, fl As Object
Dim quellbereich As Range
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
For Each fl In fc
If fl.Type = "Microsoft Excel-Arbeitsblatt" Then
Set exapp = GetObject(folderspec & "\" & fl.Name)
Set quellbereich = exapp.Sheets(1).Range(copyrange)
Call kopieren(quellbereich)
Call schliessen(fl.Name)
End If
Next
End Sub

'Kopierprozedur


Sub kopieren(quelle)
Dim zielbereich As Range
Dim r As Integer
r = WS.UsedRange.Rows.Count + 1
Set zielbereich = WS.Range("A" & r)
quelle.Copy zielbereich
End Sub

'Schließprozedur


Sub schliessen(wind)
Windows(wind).Visible = True
Application.DisplayAlerts = False
Workbooks(wind).Close
End Sub

'Ordnerdefinition
'aus Herber-Forum von K.Rola am 11.10.04


Function Ordner_def(defaultwert As Variant) As String
Dim objFolderItem As Object, strPath As String, objShell As Object
Dim objFolder As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0&, "Ordner auswählen...", 0&, defaultwert)
If objFolder Is Nothing Then End
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Ordner_def = strPath
End Function

Beliebteste Forumthreads (12 Monate)

Makro zum auslesen verschiedener Datein

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread