Sub OrderMatcher()
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
Workbooks("Order_Matcher").Worksheets(1).Range("A:A").EntireColumn.Select
Selection.Copy
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Source = "C:\Users\Maximilian\Documents\Studium\Bachelor Arbeit\Data\"
StrFile = Dir(Source)
Do While Len(StrFile) > 0
Workbooks.Open Filename:=Source & StrFile
StrFile = Dir()
Sheets.Add After:=ActiveSheet
Worksheets(2).Paste
Worksheets(1).Activate
Range("A1:Y1").Select
Selection.Copy
Worksheets(2).Select
Range("A1").Select
ActiveCell.PasteSpecial
ActiveCell.Columns("A:Y").EntireColumn.Select
ActiveCell.Columns("A:Y").EntireColumn.EntireColumn.AutoFit
MName = ActiveWorkbook.Name
Worksheets(2).Name = MName
MDir = ActiveWorkbook.Path
ActiveWorkbook.SaveAs Filename:=csPath & MName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close savechanges:=True
Loop
Application.ScreenUpdating = True
End Sub