VBA Code

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Union(Range("Mieterdaten!A1"), Range("Wasser!A1"), Range("NK_Abschlag!A1"))) Is Nothing Then Application.EnableEvents = False Dim changedCell As Range Set changedCell = Target If changedCell.Parent.Name = "Mieterdaten" Then Worksheets("Wasser").Range("A1").Value = changedCell.Value Worksheets("NK_Abschlag").Range("A1").Value = changedCell.Value ElseIf changedCell.Parent.Name = "Wasser" Then Worksheets("Mieterdaten").Range("A1").Value = changedCell.Value Worksheets("NK_Abschlag").Range("A1").Value = changedCell.Value Else Worksheets("Mieterdaten").Range("A1").Value = changedCell.Value Worksheets("Wasser").Range("A1").Value = changedCell.Value End If Application.EnableEvents = True End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA Code

03.02.2023 02:23:08

onur

AW: VBA Code

03.02.2023 02:54:26

onur

VBA Code von chatGTP?

03.02.2023 10:17:11

chatGTP?

AW: VBA Code von chatGTP?

03.02.2023 11:43:10

chatGTP?

AW: VBA Code von chatGTP?

03.02.2023 11:49:00

chatGTP?

chatGTP, weil...

03.02.2023 13:50:29

Yal

Hallo Julius,
es wäre korrekt zu erwähnen, dass diese Code von chatGTP stimmt (wenn es so ist).
Ziel ist es, wenn in A1 von einer diesen 3 Blätter etwas geändert wird, dass die Änderungen in A1 der 2 anderen übertragen wird. Man kann sogar in den 3 sagen, im eigene wird der Inhalt mit sich selbst überschrieben. Diese Verallgemeinung führt zu einem schlankeren Code ohne wesentliche zusätzliche Verarbeitungszeit.
Richtiger wäre:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ws As Worksheet
Const cBlattListe = "Mieterdaten;Wasser;NK_Abschlag"
    If Target.Address = "$A$1" And InStr(1, cBlattListe, Sh.Name, vbTextCompare) Then
        Application.EnableEvents = False
        For Each ws In Worksheets(Split(cBlattListe, ";"))
            ws.Range("A1").Value = Target.Value
        Next
        Application.EnableEvents = True
    End If
End Sub

Wichtig: diese Code gehört in dem Codepane "DieseArbeitsmappe", weil es für alle Blätter funktionieren soll. Reagieren wird es nur in den gegebenen.
chatGTP kann kommen. Ich werde trotzdem nicht Arbeitslos.
VG
Yal

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) sn = Array("Mieterdaten", "Wasser", "NK_Abschlag") If Target.Address = "$A$1" And UBound(Filter(sn, Sh.Name)) = 0 Then Application.EnableEvents = False Sheets(sn).FillAcrossSheets Target, 2 Application.EnableEvents = True End If End Sub

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread