Guten Abend!

Habe nochmal geschaut. War ein wenig mehr zum Ändern (war mit vorher gar nicht aufgefallen). Der "Type Mismatch" kommt daher, dass Tab2 und Formel nicht als String deklariert sind aber einen String bekommen. Habe ich geändert. Außerdem gibt es jetzt noch die Variable Tabe. Diese nimmt den Namen des eingefügten Blattes auf (ist ja nicht immer Worksheet3). Sonst klappt der Zugrif nicht.

Bei der Formel müsstest du MITTELWERT in deutsch lassen. Da die Formel als FormulaLocal eingefügt wird, gitl die Heimatsprache im System (ich gehe von deutsch aus). Sollte es auf einem englischen System laufen, geht auch Average. Dann müsste aber die FOrmel angepasst werden, da in der engl. Version die Interpunktion in der Formel eine andere wäre. Dann mal Bescheid geben.

Und ein letzter Punkt bzgl. der Laufzeit. Du hast beim Schließen der Dateien savechanges: true gesetzt. Das heißt, dass immer das neu eingefügte Blatt (deshalb habe ich Tabe eingeführt) und die 6600 Formel gespeichert werden müssen. Das insgesamt 65 Mal. Das hat auf meiner alten Mühle hier ziemlich gedauert. Wenn es nicht notwendig ist, das einfach auf false setzen. DAnn wird es schneller und die Daten sind ja in deine Datei übernommen.

HIer jetzt also der Code der funktionieren sollte.  (Pfade und Dateinnamen sollte passen - hoffentlich :-))

Sub Spread_CalcExp()
 'Open Files
    
    Dim Source As String
    Dim StrFile As String
    Const csPath As String = "C:\Users\Maximilian\Documents\Studium\Bachelor Arbeit\Data\Aggr_Orders_Match\"
    Dim i As Integer
    Dim j As Integer
    Dim objRange As Range
    Dim Spalte As Integer
    Dim Ausgang As String
    Dim Tab2 As String
    Dim Formel As String
    Dim Tabe As String
    
     
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
       
    'do not forget last backslash in source directory.
    Source = "C:\Users\Maximilian\Documents\Studium\Bachelor Arbeit\Data\"
    StrFile = Dir(Source)
      
    'die Datei aus der das Makro startet und die Werte eingetragen werden
    Ausgang = "Order_Spread_Export.xlsm"
  
    Do While Len(StrFile) > 0
      
    'sucht die aktuelle Spalte in der Ausgangsdatei
    Spalte = Workbooks(Ausgang).Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
      
    'öfnet die erste Datei
    Workbooks.Open Filename:=Source & StrFile
      
    ' Prozedur Spread Start
       
    Sheets.Add After:=ActiveSheet
    'Name der eingefügten Tabelle
    Tabe = Workbooks(StrFile).ActiveSheet.Name
    'einfügen der Formel, ggf. könnte man das auch mit for und einem Code durch alle 6601 durchlaufen, könnte aber länge dauern
    Tab2 = Workbooks(StrFile).Worksheets(2).Name
    Formel = "=(" & Tab2 & "!B2-" & Tab2 & "!C2)/MITTELWERT(" & Tab2 & "!B2;" & Tab2 & "!C2)"
    'Range für A2 bs A6601 festlegen
    Set objRange = Workbooks(StrFile).Worksheets(Tabe).Range("A2:A6601")    'Cells(11, 6).Resize(zeilen - 11, 1) 'Bereichlänge anpassen....
        'Formel einfügen
     
        objRange.FormulaLocal = Formel
       
    Set objRange = Nothing
      
    Workbooks(StrFile).Worksheets(Tabe).Range("A1").Value = "Relative Spread" 'Einfügen einer Überschrift
    ' die Formatierungen
    Workbooks(StrFile).Worksheets(Tabe).Range("A:A").Style = "Percent"
    Workbooks(StrFile).Worksheets(Tabe).Range("A:A").NumberFormat = "0.0000%"
     
  ' Prozedur Spread Ende
       
    'Ab hier soll die Range("A:A") in das Workbook("Order_Spread_Export") in Sheet1 in die nächste leere Spalte kopiert werden.
    ' Danach soll sich dass Variable Sheet schließen und ein neues Sheet bearbeitet werden
    Workbooks(StrFile).Worksheets(Tabe).Range("A:A").Copy
    'Odner Order_Spread_Export.xls aktivieren und dann die Werte einfügen
    Workbooks(Ausgang).Activate
    'jetzt einfügen, letzter Wert war in Spalte deshalb Spalte +1
    Workbooks(Ausgang).Worksheets(1).Columns(Spalte + 1).PasteSpecial (xlPasteValuesAndNumberFormats)
      
    Workbooks(StrFile).Close savechanges:=True
       
    ' nächste Datei holen
    StrFile = Dir()
           
    Loop
       
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Schönen Abend noch!

Gruß Matthias