Werte aus D4 aus mehreren Tabellenblättern
27.01.2010 00:58:55
NoNet
Hallo Marc,
mit diesem Makro kannst Du die Werte der Zelle D4 aus allen XLS-Dateien eines Ordners aus allen Tabellenblättern einlesen :
Sub DatenAusDiversenMappenEinlesen()
Dim strPfad As String, strDateiname As String, lngZ As Long
Dim wbExt As Workbook, wsExt As Worksheet, wsAkt As Worksheet
Set wsAkt = ActiveSheet 'In dieses Blatt werden die Daten aufgelistet
wsAkt.[A1:C1] = Array("Dateiname", "Blattname", "Inhalt Zelle D4")
lngZ = 1
Application.DisplayAlerts = False 'Warnmeldungen und Fragen abschalten
'Pfad, aus dem alle Dateien eingelesen werden sollen :
strPfad = "C:\Temp\" 'Mit "\" am Ende !!
strDateiname = Dir(strPfad & "*.xls") 'Erste Datei im Ordner einlesen
While strDateiname ""
Set wbExt = GetObject(strPfad & strDateiname)
For Each wsExt In wbExt.Worksheets
lngZ = lngZ + 1 'Zeilennummer zur Auflistung der Daten
wsAkt.Cells(lngZ, 1) = strDateiname
wsAkt.Cells(lngZ, 2) = wsExt.Name 'Name des Tabellenblattes
wsAkt.Cells(lngZ, 3) = wsExt.[D4] 'Inhalt der Zelle D4
Next
If UCase(strDateiname) UCase(ThisWorkbook.Name) Then wbExt.Close False
strDateiname = Dir 'Nächste Datei einlesen
Wend
wsAkt.Columns("A:C").AutoFit 'Spaltenbreiten A:C automatisch anpassen
Application.DisplayAlerts = True 'Warnmeldungen und Fragen wieder einschalten
End Sub
Bitte den Pfadnamen zuvor anpassen !
Das Makro berücksichtigt nicht, dass Dateien evtl. mit einem Leseschutz versehen sein können !
ACHTUNG : Die Ergebnisse werden im aktuellen Blatt in den Spalten A:C aufgelistet !
Falls in diesen Zellen bereits Werte stehen, werden diese durch das Makro überschrieben !
Makro daher möglichst aus einem leeren Tabellenblatt heraus starten !
Gruß, NoNet