Hallo und sorry für die sehr späte Antwort. Leider konnte ich mich in letzter Zeit nicht mehr mit diesem Thema befasse.

Vielen Dank auf jeden Fall für die Antwort.

Also es handelt sich um ein "ja". Ich habe es aber schon angepasst und er rechnet weder den Mittelwert noch Min oder Max. Auch bei den Eintragungen läuft etwas schief: In Zeile 1 wird nach dem öffnen des zweiten Dokuments eine 0 in Spalte F Zeile 1 eingetragen. In die folgenden Zellen von Spalte F wird dann jeweils statt des Mittelwertes die eigentliche Überschrift "Mittelwert_POS/NEG" eingetragen. 

Hier nochmal der Code:

Option Explicit
  
Sub berechnenLP()
Dim name As String
Dim name2 As String
Dim mitwe
Dim max
Dim min
Dim i As Long
Dim bedingungen
Dim pfad As String
Dim suche As String
Dim zeile As Long
Dim summe
Dim formel1
Dim formel2
Dim anzahl As Long
  
bedingungen = Array("", "NEG", "POS")
  
pfad = "C:\"  'hier den Pfad eingeben
If Right(pfad, 1) = "\" Then pfad = Left(pfad, Len(pfad) - 1)
  
Application.ScreenUpdating = False
name = ThisWorkbook.name
  
Workbooks(name).Worksheets(1).Cells(1, 1) = "Dateiname"
For i = 1 To 2
    Workbooks(name).Worksheets(1).Cells(1, 2 + (i - 1) * 3) = "Max " & bedingungen(i) & " [€/MW]"
    Workbooks(name).Worksheets(1).Cells(1, 3 + (i - 1) * 3) = "Min " & bedingungen(i) & " [€/MW]"
    Workbooks(name).Worksheets(1).Cells(1, 4 + (i - 1) * 3) = "Mittwelwert " & bedingungen(i) & " [€/MW]"
Next i
  
zeile = 2
suche = Dir(pfad & "\*.xlsx")   'suche nimmt den Dateinamen auf
    
Do Until suche = ""
  
    If Left(suche, 13) = "ERGEBNISLISTE" Then   'könnte man noch ausbauen
           
        Workbooks.Open pfad & "\" & suche
        name2 = ActiveWorkbook.name
        For i = 1 To 2
        
            Worksheets(1).Cells(1, 6).FormulaLocal = "=ZÄHLENWENNS(B1:B8000;" & Chr(34) & bedingungen(1) & "*" & Chr(34) & ";E1:E8000;" & Chr(34) & "ja" & Chr(34) & ")"
            anzahl = Worksheets(1).Cells(1, 6)
         
            Worksheets(1).Cells(1, 6).FormulaLocal = "=SUMMEWENNS(C1:C8000;B1:B8000;" & Chr(34) & bedingungen(1) & "*" & Chr(34) & ";E1:E8000;" & Chr(34) & "ja" & Chr(34) & ")"
            summe = Worksheets(1).Cells(1, 6)
            If anzahl = 0 Then
                mitwe = 0
            Else
                mitwe = summe / anzahl
            End If
 
            formel1 = "=SVERWEIS(" & Chr(34) & bedingungen(i) & "*" & Chr(34) & ";B1:D8000;2;FALSCH)"
 
            Workbooks(name2).Worksheets(1).Columns("B:E").Sort Key1:=Workbooks(name2).Worksheets(1).Range("E1"), Order1:=xlAscending, Key2:=Workbooks(name2).Worksheets(1).Range("C1"), Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
            Workbooks(name2).Worksheets(1).Cells(1, 6).FormulaLocal = formel1
            max = Worksheets(1).Cells(1, 6).Value
            Workbooks(name2).Worksheets(1).Columns("B:E").Sort Key1:=Workbooks(name2).Worksheets(1).Range("E1"), Order1:=xlAscending, Key2:=Workbooks(name2).Worksheets(1).Range("C1"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
            Workbooks(name2).Worksheets(1).Cells(1, 7).FormulaLocal = formel1
            min = Worksheets(1).Cells(1, 7).Value
               
            Workbooks(name).Worksheets(1).Cells(zeile, 4 + (i - 1) * 3) = mitwe
            Workbooks(name).Worksheets(1).Cells(zeile, 3 + (i - 1) * 3) = min
            Workbooks(name).Worksheets(1).Cells(zeile, 2 + (i - 1) * 3) = max
        Next i
            
        Workbooks(name2).Close savechanges:=False
        Workbooks(name).Worksheets(1).Cells(zeile, 1) = suche
        zeile = zeile + 1
    End If
     
    suche = Dir()
Loop
 
Workbooks(name).Worksheets(1).Range("A:M").Columns.AutoFit
Workbooks(name).Worksheets(1).Range("A:M").HorizontalAlignment = xlCenter
Application.ScreenUpdating = True
  
End Sub

Ich danke euch schon mal.

Gruß Sdeluxe