VBA - Laufendes Makro in anderer Datei beenden

Question

Ich öffne per Makro aus Excel-Datei1 eine andere bereits bearbeitete Excel-Datei ("Excel-Datei2"). Datei2 soll nun unter gleichem Namen und gleichem Pfad wie Datei1 gespeichert werden und diese somit ersetzen.

Hintergrund:
Diese Datei wird immer weiter bearbeitet und dient für viele Auswertungen als Grundlage. Um diese Datei nicht permanent an den vielen Speicherorten zu aktualisieren, habe ich diesen Ansatz gewählt.

Mein Problem:
Zunächst hab ich versucht beim Öffnen der Datei2 ein Makro zu starten auf diesem Weg Datei1 zu schließen. Soweit hat es auch funktioniert - allerdings bricht das Marko in Datei2 an dieser Stelle ab und ich kann Datei2 per Makro unter gleichem Namen und Pfad wie Datei1 abspeichern.

Ebenso ist auch der Versuch gescheitert, das Makro in Datei2 zu starten, sobald die Zelle A2 geändert wird. (Datei-Name und -Pfad von Datei1 werden in Datei2 in Zelle A1 und A2 geschrieben.) Beim Schließen von Datei1 wird auch das Marko in Datei2 beendet.

Kann mir jemand helfen?

Sub Worksheet_Change(ByVal Target As Excel.Range)

If Target.Address = "$A$2" Then
If Len(ThisWorkbook.Sheets("FiNAS Data").Cells(1, 1).Value) > 0 Then
If IsWorkbookOpen(ThisWorkbook.Sheets("FiNAS Data").Cells(1, 1).Value) Then


Dim PfadVoruebergehend As String

ThisWorkbook.Activate

PfadVoruebergehend = Sheets("FiNAS Data").Cells(2, 1).Value

'ursprüngliche Datei schließen
Workbooks(DateiVoruebergehend).Activate
ActiveWorkbook.Close savechanges:=False

'Tabellenblatt bereinigen
ThisWorkbook.Activate
Worksheets("FiNAS Data").Cells.ClearContents

'Vorlage-Scoring-Liste in Motor-Ordner unter dem Namen der dortigen Datei speichern
Application.DisplayAlerts = False
ThisWorkbook.SaveAs PfadVoruebergehend & "\" & Sheets("FiNAS Data").Cells(1, 1).Value
Application.DisplayAlerts = True
End If
End If
End If

End Sub

Function IsWorkbookOpen(DateiVoruebergehend As String) As Boolean
On Error Resume Next
IsWorkbookOpen = Not Workbooks(DateiVoruebergehend) Is Nothing
End Function

Vielen Dank für eure Hilfe!

Answer 1

Hallo Diddee,

verstehe ich das Kauderwelsch da oben richtig? Du willst also an
beliebiger Stelle eine Datei öffnen die ein Makro ausführt, das sagt,
"Überspeichere mich durch mit einer anderen Datei?" - Nun ja, es
gibt einfachere Wege die Daten aktuell zu halten, aber möglich ist
es.

Der folgende Code gehört in das Modul "Diese Arbeitsmappe" von
jeder Zieldatei die überschrieben (bzw. aktualisiert) werden soll.

Private Sub Workbook_Open()

Dim shq As Variant
Dim s As Integer

On Error GoTo Ende:

Sheets("FiNAS Data").Select
Quellpfad = Range("A1")
Quelldatei = Range("A2")

Application.EnableEvents = False

'prüft ob die Datei exisitiert
Quellpfad = Quellpfad & IIf(Right(Quellpfad, 1) = "\", "", "\")
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.fileexists(Quellpfad & Quelldatei) _
And Me.Path & "\" & Me.Name <> Quellpfad & Quelldatei Then

'Öffnet Quelldatei
Set Quelle = Workbooks.Open(Quellpfad & Quelldatei)

'Löscht die eigenen Sheets
Application.DisplayAlerts = False
Me.Sheets.Add
For s = 2 To Me.Sheets.Count
Me.Sheets(2).Delete
Next s

'Kopiert die Sheets aus der Quelldatei
For Each sh In Quelle.Sheets
shq = shq & sh.Name & "\"
Next sh
shq = Left(shq, Len(shq) - 1)
shq = Split(shq, "\")
Quelle.Sheets(shq).Copy After:=Me.Sheets(Me.Sheets.Count)
Me.Sheets(1).Delete
Application.DisplayAlerts = True

Quelle.Close False
End If

Ende:
Application.EnableEvents = True
End Sub

Tipp: Eine mögliche Alternative dazu wäre, die Quelldatei im
Explorer zu kopieren und am Zielpfad über Bearbeiten -->
Verknüpfung einfügen einen Link einzufügen. So sparst du
Speicherplatz auf deiner Festplatte.

Gruß Mr. K.

Answer 2

Vielen Dank xlKing! Dieser Ansatz hilft mir auf jeden Fall weiter. Ausprobieren kann ich es zwar erst später. Ich war in meine Vorstellung so festgefahren, dass ich gar nicht ans kopieren der einzelnen Sheets dachte!