Wechselseitige Syncronisierung zweier Tabellen (VBA)

Josef, Donnerstag, 09.07.2020, 10:09 (vor 73 Tagen)

Hallo an alle,

ich bin neu mit VBA unterwegs und bräuchte mal eure Hilfe.
Ich habe zwei unterschiedliche Arbeitsmappen/Dateien in denen aber jeweils eine Tabelle mit dessen Inhalten und idealerweise der Formatierungen (Verbundene Zellen, etc.) gleich sein sollen.
Nun kommt die große Problemstellung: Ich muss in beiden Arbeitsmappen an der Tabelle (mit Textinhalt, Datum, Zahlen) arbeiten können. Das heißt, dass sich die Tabellen in beide Richtungen/Arbeitsmappen synchronisiren müssen.
Hierbei muss evtl. auch der Zeitpunkt der Synchronisierung (Speichervorgang?) beachtet werden damit es zu keinen Konflikten kommt!?

Ich habe mal aus unterschiedlichen Beiträgen versucht erste Ansätze zu basteln was aber leider nicht funktioniert:

 
'Code für Datei 1 "AM1_test.xlsm"
 
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ext_wb As Workbook
    If Not Intersect(Target, Columns(1:19)) Is Nothing Then
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
        Set ext_wb = Workbooks.Open(ThisWorkbook.Path & "\AM2_test.xlsm")
        ext_wb.Worksheets("offene Punkte").Range(Target.Address) = Target.Value
        Call ext_wb.Close(SaveChanges:=True)
        Set ext_wb = Nothing
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    End If
End Sub
 
 
'Code für Datei 2 "AM2_test.xlsm"
 
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ext_wb As Workbook
    If Not Intersect(Target, Columns(1:19)) Is Nothing Then
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
        Set ext_wb = Workbooks.Open(ThisWorkbook.Path & "\AM1_test.xlsm")
        ext_wb.Worksheets("offene Punkte").Range(Target.Address) = Target.Value
        Call ext_wb.Close(SaveChanges:=True)
        Set ext_wb = Nothing
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    End If
End Sub


Ich habe den Code bei der jeweiligen Arbeitsmappe unter "VBAProjekt (Dateiname.xlsm)" eingefügt.
Zum Testen habe ich eine der Dateien geöffnet, eine Änderung in der Tabelle "offene Punkte" durchgeführt und gespeichert.
Leider ohne programmseitige Reaktion bzw. Änderung in der anderen Datei.

Ich bin Anfänger mit VBA. Da ich mich hier noch sehr unsicher bewege, benötige ich bitte genauere Anweisungen als nur eine Codezeile oder den Verweis auf einen anderen Befehl. Danke für euer Verständnis!

Erkennt jemand den Fehler oder hat eine Idee?

Mit Dank im Vorraus
Gruß Josef

Wechselseitige Syncronisierung zweier Tabellen

Martin Asal @, Donnerstag, 09.07.2020, 14:55 (vor 72 Tagen) @ Josef

Hallo Josef,

ich halte das mit der wechselseitigen Synchronisation für gar keine gute Idee und auchnicht für notwendig. Sofern die anderen Arbeitsblätter in den beiden Dateien auf dieses Blatt zugreifen, kann das auch anders gelöst werden: Erstelle eine dritte Datei, in der nur dieses eine Blatt enthalten ist. Darauf kannst du dann wie folgt zugreifen:

=[DritteDatei.xlsx]Tabelle1!A1


Martin

Wechselseitige Syncronisierung zweier Tabellen

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

ES LEBT! :D

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!

RSS-Feed dieser Diskussion
powered by my little forum