Forum des Access-Tutorials

Wechselseitige Syncronisierung zweier Tabellen (VBA)

Josef, Donnerstag, 09.07.2020, 16:36 (vor 36 Tagen) @ Josef

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
'Für die erste Datei "AM1_test":
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

'Für die zweite Datei "AM2_test":
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!