Probleme mit einer VBA von Chatgpt

[Baladini]

Hallo Ich bin ziemlich neu bei Excel.
Ich habe folgendes Anliegen ich würde gerne 2 Zellen synchronisieren so das immer das gleiche in beiden steht und zwar immer dann wenn ich eine von von diesen ändere. Die beiden Zellen befinden sich auf unterschiedlichen Arbeitsblättern. Zudem soll in einer dritten Zelle immer der Zeitpunkt der letzten Änderung angezeigt werden (datum und Uhrzeit). Jetzt habe chatgpt gefragt und habe eine VBA bekommen. Diese funktioniert auch, jedoch nur bei Änderung der Zelle auf dem 1.Blatt bei allen andern Zellen kommt die Fehlermeldung Laufzeitfehler 1004. Könnte mir jemand vielleicht helfen anbei einmal das VBA Makro:
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim cell1 As Range
Dim cell2 As Range

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Set ws1 = ThisWorkbook.Sheets("Sheet1") ' Name des ersten Arbeitsblatts
    Set ws2 = ThisWorkbook.Sheets("Sheet2") ' Name des zweiten Arbeitsblatts
   
    ' Setze die Zellen, die synchronisiert werden sollen
    Set cell1 = ws1.Range("A1") ' Zelle auf dem ersten Arbeitsblatt
    Set cell2 = ws2.Range("A1") ' Zelle auf dem zweiten Arbeitsblatt

    ' Prüfe, ob die geänderte Zelle eine der synchronisierten Zellen ist
    If Not Intersect(Target, cell1) Is Nothing Then
        Application.EnableEvents = False
        cell2.Value = Target.Value
        ws1.Range("C1").Value = Now ' Aktualisiere Datum und Uhrzeit in Zelle C1 auf dem ersten Arbeitsblatt
        Application.EnableEvents = True
    ElseIf Not Intersect(Target, cell2) Is Nothing Then
        Application.EnableEvents = False
        cell1.Value = Target.Value
        ws1.Range("C1").Value = Now ' Aktualisiere Datum und Uhrzeit in Zelle C1 auf dem ersten Arbeitsblatt
        Application.EnableEvents = True
    End If
End Sub


Bin auch für ander Lösungen offen 

[BoskoBiati]

Hi,

Crosspost:

https://www.herber.de/cgi-bin/eachthread.pl?idx=1983501

[juvee]

Hi,

ich finde, 1 Belehrung über crossposting ( schlag nach bei  Herber ) ist ausreichend. Hilft dem Petenten aber lediglich für die künftigen Fragestellungen, lösen aber sein Problem nicht.


nachfolgender Code gehört in den Codebereich des Klassenmoduls DieseArbeitsmappe

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim srcSheet As Worksheet
    Dim trgSheet As Worksheet
    Dim trgSheetName As String

    'Prüfen welche Tabelle geändert wurde
    If Sh.Name = "Tabelle1" Or Sh.Name = "Tabelle2" Then
      If Not Intersect(Target, Sh.Cells(1, 1)) Is Nothing Then
          Application.EnableEvents = False
            trgSheetName = IIf(Right(Sh.Name, 1) = 1, "Tabelle2", "Tabelle1")
            Set srcSheet = Sh
            Set trgSheet = ThisWorkbook.Worksheets(trgSheetName)
            trgSheet.Cells(1, 1).Value = Target.Value
            srcSheet.Cells(1, 3).Value = Now
          Application.EnableEvents = True
      End If
    End If

End Sub

VG Juvee

[Baladini]

Danke es funktioniert
Vielen vielen Dank

Und für nächste mal weiß ich dann wie man ein Forum richtig benutzt.

Danke nochmals