folgende Zielvorgabe:
Ein Ordner enthält ca. 150 *.xlsx Dateien gleichen Aufbaus. Es soll ein Dokument erstellt werden, dass die Werte der Zellen B2 und c26:s26 der ersten Datei spaltenweise in Zeile 1 nebeneinander stellt und die selben Werte aus den übrigen Dateien zeilenweise untereinander auflistet.
Das Problem: Die Dir() Funktion erkennt scheinbar die Dateinamen nicht und springt direkt zum Ende der Prozedur (ohne Fehlermeldung). Mein Ansatz war:
Option Explicit
Public Sub ExcelDateienAuswerten()
Dim strDateiname As String
Dim strPfad As String
Dim lngZeile As Long
'Pfadangabe, in dem die zu lesenden Excel-Datei (*.xl) liegen
strPfad = "C:\Users\...\Desktop\AZN"
'Den 1. Dateinamen holen
strDateiname = Dir(strPfad & "*.xlsx")
'Startzeile festlegen
lngZeile = 2
'Solange ein Dateiname gelesen wird
Do While strDateiname ""
'Datei verarbeiten
Call TabVerarb(strPfad & strDateiname, lngZeile)
'nächsten Dateinamen holen
strDateiname = Dir()
'Zeilenzähler erhöhen
lngZeile = lngZeile + 1
Loop
End Sub
Public Sub TabVerarb(strPfad As String, lngZeile As Long)
Dim strMeSH As String
Dim strDatei As String
Dim strSH As String
'Dateinamen extrahieren
strDatei = Split(strPfad, "\")(UBound(Split(strPfad, "\")))
'Eigenen Namen merken
strMeSH = ActiveWorkbook.Name
'Datei öffnen
Workbooks.Open Filename:=strPfad
With Workbooks(strMeSH)
'Dateinamen und auszuwertenden Zellen übertragen
.Sheets("Tabelle1").Cells(lngZeile, 1) = strDatei
.Sheets("Tabelle1").Cells(lngZeile, 2) = Workbooks(strDatei).Sheets("Tabelle2").Range(" _
_
B2").Value
.Sheets("Tabelle1").Cells(lngZeile, 3) = Workbooks(strDatei).Sheets("Tabelle2").Range(" _
_
C26").Value
.Sheets("Tabelle1").Cells(lngZeile, 4) = Workbooks(strDatei).Sheets("Tabelle2").Range(" _
_
D26").Value
.Sheets ... usw. bis S26
End With
'Quelldatei schließen
Workbooks(strDatei).Saved = True
Workbooks(strDatei).Close
End Sub