Hey!
Ich arbeite erst seit Mittwoch mit VBA, habe aber direkt eine schwierige (für mich zumindest) Aufgabe bekommen. Ich bin mittlerweile soweit:


Option Explicit

Sub Kreditakte_auslesen()
LoopThroughFolder "C:\Users\......\Daten\", Split("xlsx", ",") 'such in C:\YourFolder nach xls, xlsx oder xlsm
End Sub

Public Sub LoopThroughFolder(path As String, Filter As Variant)
Dim fso, oFolder, oSubfolder, oFile, queue As Collection
'On Error Resume Next 'Falls Permission denied nächsten Folder/File nehmen (quick n dirty)
Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder(path)
path = "C:\Users\......\Daten\"

Dim strTabName As Variant
strTabName = "Datensheet"
Dim lngR As Long
Dim i As Integer
lngR = 1
lngR = lngR + 1
i = 0
oFile = Dir(path & "*.xlsx")

ThisWorkbook.Sheets("Kreditakte").Cells(1, 1) = "Link"
ThisWorkbook.Sheets("Kreditakte").Cells(1, 2) = "Dateiname"
ThisWorkbook.Sheets("Kreditakte").Cells(1, 3) = "Nummerr"
ThisWorkbook.Sheets("Kreditakte").Cells(1, 4) = "Name2"
ThisWorkbook.Sheets("Kreditakte").Cells(1, 5) = "Name3"
ThisWorkbook.Sheets("Kreditakte").Cells(1, 6) = "Name4"
ThisWorkbook.Sheets("Kreditakte").Cells(1, 7) = "Name5"
ThisWorkbook.Sheets("Kreditakte").Cells(1, 8) = "Name6"
ThisWorkbook.Sheets("Kreditakte").Cells(1, 9) = "Name7"
ThisWorkbook.Sheets("Kreditakte").Cells(1, 10) = "Name8"

Do While queue.Count > 0
Set oFolder = queue(1)
queue.Remove 1
For Each oSubfolder In oFolder.SubFolders
If oSubfolder <> vbEmpty Then queue.Add oSubfolder
Next

For Each oFile In oFolder.Files
If oFile <> vbEmpty Then
If IsInArray(fso.GetExtensionName(oFile.path), Filter) Then
Debug.Print oFile.path

Dim wkb As Workbook
Dim wks As Worksheet
Set wkb = Workbooks.Open(oFile)
Set wks = wkb.Sheets(strTabName)

ThisWorkbook.Sheets("Kreditakte").Cells(lngR + i, 1) = path
ThisWorkbook.Sheets("Kreditakte").Cells(lngR + i, 2) = oFile
ThisWorkbook.Sheets("Kreditakte").Cells(lngR + i, 3) = wks.Cells(1, 2 + i)
ThisWorkbook.Sheets("Kreditakte").Cells(lngR + i, 4) = wks.Cells(2, 2 + i)
ThisWorkbook.Sheets("Kreditakte").Cells(lngR + i, 5) = wks.Cells(3, 2 + i)
ThisWorkbook.Sheets("Kreditakte").Cells(lngR + i, 6) = wks.Cells(4, 2 + i)
ThisWorkbook.Sheets("Kreditakte").Cells(lngR + i, 7) = wks.Cells(5, 2 + i)
ThisWorkbook.Sheets("Kreditakte").Cells(lngR + i, 8) = wks.Cells(6, 2 + i)
ThisWorkbook.Sheets("Kreditakte").Cells(lngR + i, 9) = wks.Cells(7, 2 + i)
ThisWorkbook.Sheets("Kreditakte").Cells(lngR + i, 10) = wks.Cells(8, 2 + i)


i = i + 1

End If
End If

wkb.Saved = True
wkb.Close

Next
Loop
End Sub

Function IsInArray(str As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, str)) > -1)
End Function


Jetzt sagt Excel mir aber bei folgender Zeile, "Index außerhalb des gültigen Bereichs": Set wks = wkb.Sheets(strTabName)


Ich habe schon geschaut, alle Namen sind richtig geschrieben....

Hoffe ihr könnt mir helfen!

Danke schonmal

ahh, vielen Dank. ist mir noch nicht aufgefallen -.- Danke

aber mein problem ist schon gelöst. es war ein leerzeichen zu viel!
In zukunft mache ich es so, danke