AW: Werte aus geschlossenen sich ändernden Mappen samm
30.09.2008 17:47:00
fcs
Hallo marko,
hier mal ein Ansatz.
Gruß
Franz
Sub DatenSammeln()
Dim wbZiel As Workbook, wksZiel As Worksheet, lngZeileZiel As Long
Dim wbQuelle As Workbook, wksQuelle As Worksheet, intI As Integer
Dim strDateiname As String
Const strVerzeichnis As String = "C:\Lokale Daten\Test\Daten" 'anpassen!!!
'Zieldatei
Set wbZiel = ActiveWorkbook
'Zieltabellenblatt festlegen
Set wksZiel = wbZiel.Worksheets("Tabelle1") 'ggf. anpassen!!!
lngZeileZiel = 2 'Startzeile für eintragen der Daten 'ggf.anpassen!!!
'Dateien der letzten 30 Tage auslesen
Application.ScreenUpdating = False
For intI = 29 To 0 Step -1
'Dateiname aus Datum erzeugen
strDateiname = Format(Date - intI, "YYYY.MM.DD") & ".xls"
'Prüfen ob Datei vorhanden
If Dir(strVerzeichnis & "\" & strDateiname) "" Then
'Datei mit Daten schreibgeschützt öffnen
Set wbQuelle = Workbooks.Open(Filename:=strVerzeichnis & "\" & strDateiname, _
ReadOnly:=True)
'Quelltabellenblatt festlegen
Set wksQuelle = wbQuelle.Worksheets(1)
'daten aus A1 in Zieltabelle in Spalte A (1) eintragen
wksZiel.Cells(lngZeileZiel, 1) = wksQuelle.Range("A1") 'ggf. anpassen!!!
'Datendatei wieder schliessen
wbQuelle.Close savechanges:=False
lngZeileZiel = lngZeileZiel + 1
End If
Next
Application.ScreenUpdating = True
End Sub