Sub Spread_CalcExp()
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
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Source = "C:\Users\Maximilian\Documents\Studium\Bachelor Arbeit\Data\"
StrFile = Dir(Source)
Ausgang = "Order_Spread_Export.xls"
Do While Len(StrFile) > 0
Spalte = Workbooks(Ausgang).Worksheets(1).Cells(2, Columns.Count).End(xlToLeft).Column
Workbooks.Open Filename:=Source & StrFile
Sheets.Add After:=ActiveSheet
Set objRange = Workbooks(StrFile).Worksheets(3).Range("A2:A6601")
objRange.FormulaLocal = "=(Tabelle2!B2-Tabelle2!C2)/MITTELWERT(Tabelle2!B2;Tabelle2!C2)"
Set objRange = Nothing
Workbooks(StrFile).Worksheets(3).Range("A1").Value = "Relative Spread"
Workbooks(StrFile).Worksheets(3).Range("A:A").Style = "Percent"
Workbooks(StrFile).Worksheets(3).Range("A:A").NumberFormat = "0.0000%"
Workbooks(StrFile).Worksheets(3).Range("A:A").Copy
Workbooks(Ausgang).Activate
Workbooks(Ausgang).Worksheets(1).Columns(Spalte + 1).PasteSpecial (xlPasteValues)
Workbooks(StrFile).Close savechanges:=False
StrFile = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub