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
Dim Tab2 As String
Dim Formel As String
Dim Tabe As String
Dim Nam2 As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Source = "C:\Users\Maximilian\Documents\Studium\Bachelor Arbeit\Data\"
StrFile = Dir(Source & "*.xls")
Ausgang = "Order_Spread_Export.xlsm"
Do While Len(StrFile) > 0
Spalte = Workbooks(Ausgang).Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
Workbooks.Open Filename:=Source & StrFile
Sheets.Add After:=ActiveSheet
Tabe = Workbooks(StrFile).ActiveSheet.Name
Tab2 = Workbooks(StrFile).Worksheets(2).Name
On Error Resume Next
For i = 2 To 6601
Workbooks(StrFile).Worksheets(Tabe).Cells(i, 1) = 2 * (Workbooks(StrFile).Worksheets(Tab2).Cells(i, 2) - Workbooks(StrFile).Worksheets(Tab2).Cells(i, 3)) / (Workbooks(StrFile).Worksheets(Tab2).Cells(i, 2) + Workbooks(StrFile).Worksheets(Tab2).Cells(i, 3))
Next i
Workbooks(StrFile).Worksheets(Tabe).Range("A1").Value = "Relative Spread"
Workbooks(StrFile).Worksheets(Tabe).Range("A:A").Style = "Percent"
Workbooks(StrFile).Worksheets(Tabe).Range("A:A").NumberFormat = "0.0000%"
Workbooks(StrFile).Worksheets(Tabe).Range("A:A").Copy
Workbooks(Ausgang).Activate
Workbooks(Ausgang).Worksheets(1).Columns(Spalte + 1).PasteSpecial (xlPasteValuesAndNumberFormats)
Workbooks(StrFile).Close savechanges:=True
StrFile = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub