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
|