Viele Dateien auslesen OHNE öffnen
20.05.2013 01:39:37
Dietmar
habe folgenden Code, der auch recht zufriedenstellend funktioniert.
Diese liest fest definierte Zellen aus und überträgt sie Zeile für Zeile in das Auswertungssheet *Auswertung_KW20_2013_02*
Mein Problem:
Alle auszuwertenden Datein werden zunächst geöffnet und dann ausgelesen.
Bei ca. 2000 Dateien dauert das ca. 12 Minuten.
Meine Frage:
Kann man den Code anpassen, so dass die Dateien NICHT GEÖFFNET werden müssen?
Ich denke dann sollte es wesentlich schneller gehen.
Vielen Dank
LG Dietmar
Sub Auswerten()
Dim wkbAktives As Workbook
Dim wkbAuswertung As Workbook
Dim DokumentName As String
Set wkbAuswertung = Workbooks("Auswertung_KW20_2013_02.xls")
Dim ZeilenCounter As Integer
ZeilenCounter = 56
Dim file As Variant
file = Dir(ThisWorkbook.Path & "\Kalenderwoche20*.xls")
While (file "")
Set wkbAktives = Workbooks.Open(ThisWorkbook.Path & "\" & file)
wkbAuswertung.Sheets(1).Cells(ZeilenCounter, 1).Value =
wkbAktives.Sheets(1).Range("B5")
wkbAuswertung.Sheets(1).Cells(ZeilenCounter, 1).Value =
wkbAktives.Sheets(1).Range("B5")
wkbAuswertung.Sheets(1).Cells(ZeilenCounter, 2).Value =
wkbAktives.Sheets(1).Range("B10")
wkbAuswertung.Sheets(1).Cells(ZeilenCounter, 3).Value =
wkbAktives.Sheets(1).Range("B13")
wkbAuswertung.Sheets(1).Cells(ZeilenCounter, 4).Value =
wkbAktives.Sheets(1).Range("G78")
wkbAuswertung.Sheets(1).Cells(ZeilenCounter, 5).Value =
wkbAktives.Sheets(1).Range("G79")
wkbAuswertung.Sheets(1).Cells(ZeilenCounter, 6).Value =
wkbAktives.Sheets(1).Range("G80")
wkbAuswertung.Sheets(1).Cells(ZeilenCounter, 7).Value =
Application.WorksheetFunction.Sum(wkbAktives.Sheets(1).Range("D155:D174"))
wkbAuswertung.Sheets(1).Cells(ZeilenCounter, 8).Value =
Application.WorksheetFunction.Sum(wkbAktives.Sheets(1).Range("D176:D193"))
wkbAuswertung.Sheets(1).Cells(ZeilenCounter, 9).Value =
Application.WorksheetFunction.Sum(wkbAktives.Sheets(1).Range("D155:D344"))
wkbAuswertung.Sheets(1).Cells(ZeilenCounter, 10).Value =
wkbAktives.Sheets(1).Range("I78")
wkbAuswertung.Sheets(1).Cells(ZeilenCounter, 11).Value =
wkbAktives.Sheets(1).Range("I345")
'Schließe aktive Datei ohne zu speichern
wkbAktives.Close (False)
'Wähle nächste Datei
file = Dir
'Setze den Zeilen Zeiger eins weiter
ZeilenCounter = ZeilenCounter + 1
Wend
ThisWorkbook.Save
End Sub