Ich habe folgendes schon geschrieben (mit Hilfe der Suche hier), das klappt auch wie es soll. Wie kann ich aber jetzt auch noch die Dateien der Unterordner mitauslesen?
Dim strVerzeichnis As String
Dim StrDatei As String
Dim I As Integer
Dim A As Integer
Dim StrTyp As String
Dim Dateiname As String
strVerzeichnis = "C:\test\"
StrTyp = "*.xls"
Dateiname = Dir(strVerzeichnis & StrTyp)
If Dateiname = "" Then
Beep
goto1
MsgBox "Keine Dateien gefunden! Die auszuwertenden Wochenberichte bitte nach C:\test kopieren!"
End
End If
goto4
I = 2
A = 9
With Workbooks(ThisWorkbook.Name).ActiveSheet
Do While Dateiname <> ""
.Cells(I, 1).Value = Dateiname
Workbooks.Open Filename:=strVerzeichnis & Dateiname
.Cells(I, 2) = Range("E4")
.Cells(I, 3) = Range("F4")
.Cells(I, 4) = Range("G4")
.Cells(I, 5) = Range("H4")
.Cells(I, 6) = Range("I4")
.Cells(I, 7) = Range("B9")
.Cells(I, 8) = Range("C9")
.Cells(I, 9) = Range("D9")
.Cells(I, 10) = Range("E9")
.Cells(I, 11) = Range("F9")
.Cells(I, 12) = Range("G9")
.Cells(I, 13) = Range("H9")
.Cells(I, 14) = Range("I9")
.Cells(I, 15) = Range("J9")
.Cells(I, 16) = Range("K9")
I = I + 1
.Cells(I, 1).Value = Dateiname
.Cells(I, 2) = Range("E4")
.Cells(I, 3) = Range("F4")
.Cells(I, 4) = Range("G4")
.Cells(I, 5) = Range("H4")
.Cells(I, 6) = Range("I4")
.Cells(I, 7) = Range("B10")
.Cells(I, 8) = Range("C10")
.Cells(I, 9) = Range("D10")
.Cells(I, 10) = Range("E10")
.Cells(I, 11) = Range("F10")
.Cells(I, 12) = Range("G10")
.Cells(I, 13) = Range("H10")
.Cells(I, 14) = Range("I10")
.Cells(I, 15) = Range("J10")
.Cells(I, 16) = Range("K10")
I = I + 1
usw.......
ActiveWorkbook.Close False
I = I + 1
Dateiname = Dir
Loop
End With
End Sub