Hallo! Also mit der 2013 Version sollte es (vermtl. - konnte nicht umfassend testen) mit folgendem Code laufen. Der Code ist jetzt  nur für Spalte C. Weiß nicht genau, ob du für Spalte D ein eigenes Makro hast oder das in einer Schleifer (erst C dann D) laufen lässt). Zum Anpassen auf D bei der Berechnung der Summe, hier: "=SUMMEWENNS den ersten Parameter auf D1:D8000 setzen. Beim SVerweis wieder auf 3 setzen und die Sortierung von C auf D wechlsen (dort der 2 Sortierwert). Schau mal bitte ob das so klappt. Schönen Tag noch.

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 = ""  '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