ES LEBT!

Für meine Leidensgenossen nun eine Zusammenfassung:

Ziel: Eine identische Tabelle (hier nur die Spalten A-S) in zwei Arbeitsmappen. Hierbei war die Problemstellung, dass Änderungen in beiden Dateien übernommen werden. Dies geschiet unabhängig davon in welcher Datei die Änderung vorgenommen wird.

Der Code wird in der zu übernehmenden Tabelle hinterlegt und nicht wie Anfangs von mir angenommen in der Arbeitsmappe. Dies geschieht natürlich in beiden Dateien!

 

Code: Alles auswählen

[u]'Für die erste Datei "AM1_test":[/u]
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ext_wb As Workbook
    If Not Intersect(Target, Columns("A:S")) Is Nothing Then                      'Hier werden die Spalten "A-S" auf Änderungen geprüft.
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
        Set ext_wb = Workbooks.Open(ThisWorkbook.Path & "\AM2_test.xlsm")        'Hier muss die andere Datei als Pfad angegeben werden "\AM2_test.xlsm" (gleicher Ordner)
        ext_wb.Worksheets("offene Punkte").Range(Target.Address) = Target.Value  'Hier wird der Name des Reiters der Tabelle angegeben "offene Punkte"
        Call ext_wb.Close(SaveChanges:=True)
        Set ext_wb = Nothing
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    End If
End Sub

[i]'Für die zweite Datei "AM2_test":[/i]
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ext_wb As Workbook
    If Not Intersect(Target, Columns("A:S")) Is Nothing Then                                   'Hier werden die Spalten "A-S" auf Änderungen geprüft.
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
        Set ext_wb = Workbooks.Open(ThisWorkbook.Path & "\AM1_test.xlsm")        'Hier muss die andere Datei als Pfad angegeben werden "\AM1_test.xlsm" (gleicher Ordner)
        ext_wb.Worksheets("offene Punkte").Range(Target.Address) = Target.Value   'Hier wird der Name des Reiters der Tabelle angegeben "offene Punkte"
        Call ext_wb.Close(SaveChanges:=True)
        Set ext_wb = Nothing
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    End If
End Sub

Einen großen Dank nochmal an Nepumuk!