Excel-Makro verliert Pfad
02.06.2009 11:38:38
grethen@gmx.de
ich lese über ein Makro mehrere hundert identische Excel-Dateien aus. Um nicht Stunden warten zu müssen habe versuche ich das ganze über Verknüpfungen zu lösen, was auch ganz gut klappt. Ich habe aber zwei Probleme.
1. Das Makro verliert nach etwa fünf Zeilen den Pfad zu den Dateien und das öffnen-Fenster des Dateibrowsers öffnet sich.
2. Einige Dateien sind nicht ganz identisch, da sie älter sind. Diese würde ich gerne überspringen, wenn sie nicht dem Ausleseschema entsprechen.
hier der code:
---------------------------------
Sub Daten_auslesen()
Dim Pfad, Dateiname As String, iRow As Long
Application.ScreenUpdating = True
Pfad = "C:\test\"
Dateiname = Dir(Pfad & "*.xls")
Do While Dateiname ""
' --- zu befüllende Zeile ermitteln (immer erste Zeile ohne Inhalt in Spalte A)
iRow = ThisWorkbook.Sheets("Tabelle1").Range("A65536").End(xlUp).Offset(1, 0).Row
' --- Spalte 1 Dateiname der auszulesenden Datei
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 1) = Dateiname
' --- Spalte 2-9 diverse Werte aus ein jeweiligen Böättern der Exeldateien.
ActiveSheet.Cells(iRow, 2) = "=[" & Dateiname & "]Kalkulation!$D$8"
ActiveSheet.Cells(iRow, 3) = "=[" & Dateiname & "]Kalkulation!$D$6"
ActiveSheet.Cells(iRow, 4) = "=[" & Dateiname & "]Satzauftrag!$K$19"
ActiveSheet.Cells(iRow, 5) = "=[" & Dateiname & "]Druckauftrag!$K$19"
ActiveSheet.Cells(iRow, 6) = "=[" & Dateiname & "]Nachkalkulation!$G$20"
ActiveSheet.Cells(iRow, 7) = "=[" & Dateiname & "]Nachkalkulation!$G$27"
ActiveSheet.Cells(iRow, 8) = "=[" & Dateiname & "]Nachkalkulation!$G$33"
ActiveSheet.Cells(iRow, 9) = "=[" & Dateiname & "]Nachkalkulation!$G$51"
Dateiname = Dir()
Loop
' --- Am schluss Verknüpfungen in Werte umgewandelt werden.
Columns("A:I").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End
Sub
Vielen Dank schon mal im Voraus