Hallo zusammen,

ich hab noch ein Problem. Ich möchte zwischen 2 Workbooks einmal wechseln. Ich habe eine "Fix" Datei (in der sich der VBA Code befindet), die immer geöffnet bleibt. Zudem habe ich noch 80 weitere Dateien die bearbeitet werden sollen. Bis jetzt hat das einwandfrei geklappt. 1 Datei öffnet sich, die Prozedur wird abgearbeitet und das Workbook wird in einem anderen Ordner abgespeichert und geschlossen und die nächste Datei öffnet sich usw.

Nun möchte ich aber während der Prozedur, dass sich die "Variable Datei" also, die die geöffnet wird sich einmal von der Fix Datei kopiert und dann bei sich einfügt. Ich weiß, dass ich der Datei eine Variable geben muss aber bis jetzt erscheint beim wechsel zwischen den Workbooks "Subscript out of range".

Vielleicht hat einer eine Idee.

Sub OrderMatcher()
 '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
    
    
    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)

    Do While Len(StrFile) > 0
        Workbooks.Open Filename:=Source & StrFile
        StrFile = Dir()
   
    Sheets.Add After:=ActiveSheet
    Windows("Order_Matcher.xlsm").Activate
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows(StrFile).Activate 'Hier bleibt das Makro stehen
    ActiveSheet.Paste 

'Ab hier wird nur noch die Prozedur innerhalb der aufgerufenen Datei abgespielt werden
' Nach Ablauf der Prozedur wird die Datei dann noch angepasst und gespeichert.

Worksheets(1).Activate
    Range("A1").Select
    Range(Selection, Selection.End(xlLeft)).Select
    Selection.Copy
    Worksheets(2).Activate
    Range("A1").Paste
       
    ActiveCell.Columns("A:Y").EntireColumn.Select
    ActiveCell.Columns("A:Y").EntireColumn.EntireColumn.AutoFit
   
    

    MName = Workbook.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

Vielen Dank für die Hilfe