Die Anzahl ist dem Code egal.Also bei mir läuft es problemlos. Ich vermute, dass es entweder am Namen der Datei liegt oder das er den Pfad nicht erkennt - weil es ein Server ist. Und jetzt habe ich eine Idee und falls es das war, entschuldige ich mich vielmals. :-D Ich arbeite mit Excel2003. Deswegen sind meine Dateien xls. Manchmal vergesse ich das beim posten zu ändern. Da du mit Excel 2007 arbeitest sollten es wohl xlsx Dateien sein. Jetzt cer Code von letzten aber für xlsx. FAlls es das nicht war, weil du es schon angepasst hattest, dann müsstest du mal im VBE den Code SChrittweise durchgehen und schauen, was er in der Function bei quelle reinschreibt. Aber testen wir es erstmal mit dem Code unten. Wieder den Pfad eingeben und probieren. Ich suche jetzt wieder nach 2016 und _Planung. Wenn die Dateien anders heißen, das in der function nochmal anpassen. Gruß

Dim dateien()
Option Explicit
   
Sub DateienLesen()
     
Dim DateiName As String
Dim quelle As String
Dim i As Long
Dim j As Long
Dim Dateialt As String
Dim zeilealt As Long
Dim Namekurz As String
Dim Blatt As Object
Dim gefunden As Boolean
Dim suchwert As Variant
Dim suche As Variant
 Dim test
    
  
Dateialt = ThisWorkbook.Name
zeilealt = 1
 
suchwert = InputBox("Zu suchenden Wert eingeben!", "Suchtexteingabe")
 
ReDim dateien(0)
dateien(0) = 0
       
quelle = "" 'Pfad eintragen
If Right(quelle, 1) = "\" Then quelle = Left(quelle, Len(quelle) - 1)

If Dir(quelle & "\") = "" Then
    MsgBox "Der Pfad wurde nicht gefunden!"
    End
End If

Call txtsuchen(quelle)
  
If dateien(0) = 0 Then
MsgBox "Keine Dateien gefunden!"
Else
'Daten auslesen
          
    For i = 1 To dateien(0)
    DateiName = dateien(i)
    Namekurz = Right(DateiName, InStr(1, StrReverse(DateiName), "\") - 1)
    gefunden = False
     
    'die Mappen aufmachen
    Workbooks.Open DateiName, Password:="ABC"
      
    For Each Blatt In Worksheets
        suche = Application.WorksheetFunction.CountIf(ActiveSheet.UsedRange, suchwert)
         
        If suche > 0 Then gefunden = True
         
    Next Blatt
         
    Workbooks(Dateialt).Activate
    Workbooks(Namekurz).Close savechanges:=False
     
    If gefunden = True Then
        ActiveSheet.Hyperlinks.Add anchor:=ActiveSheet.Cells(zeilealt, 1), Address:=DateiName, TextToDisplay:=Namekurz
        zeilealt = zeilealt + 2
    End If
 
    Next i
End If
          
End Sub
    
 
  
Function txtsuchen(quelle As String)
Dim suche
Dim ordner()
Dim i As Long
   
ReDim ordner(0)
ordner(0) = 0
ChDrive (Left(quelle & "\", 3))
ChDir (quelle)
  
'Ordner durchschauen
suche = Dir(quelle & "\*.*", vbDirectory)
   
Do Until suche = ""
    'Normale Dateien rausfiltern
    If (GetAttr(quelle & "\" & suche) = 16) Then
        'die hier ankommen, sind Ordner, extra speichern
        ordner(0) = ordner(0) + 1
        ReDim Preserve ordner(ordner(0))
        ordner(ordner(0)) = suche
    Else
        If Right(suche, 5) = ".xlsx" Then    'ggf. noch an xlsx anpassen etc. aber auch die Zahl dazu
            If Len(suche) <> Len(Replace(suche, "_Planung", "")) And Len(suche) <> Len(Replace(suche, "2016", "")) Then
                dateien(0) = dateien(0) + 1
                ReDim Preserve dateien(dateien(0))
                dateien(dateien(0)) = quelle & "\" & suche
            End If
        End If
    End If
           
    suche = Dir()
Loop
'jetzt durch die Ordner gehen
For i = 1 To UBound(ordner)
    If Dir(ordner(i), vbNormal) = "" And Left(ordner(i), 1) <> "." Then
        Call txtsuchen(quelle & "\" & ordner(i))
        ChDir (quelle)
    End If
Next
End Function