Werte automatisch übertragen

Private Sub Worksheet_Change(ByVal Target As Range)



    tbl_Kalkulation.Unprotect ("20")

    

    Dim sourceRange As Range

    Dim targetRange As Range

    Dim cell As Range



    ' Definiere die Quell- und Zielbereiche

    Set sourceRange = Me.Range("B1471:B1477")

    Set targetRange = Me.Range("B1517:B1523")



    ' Überprüfe, ob die geänderte Zelle im Quellbereich liegt

    If Not Intersect(Target, sourceRange) Is Nothing Then

        Application.EnableEvents = False ' Deaktiviere Event-Handling vorübergehend, um Endlosschleife zu vermeiden

        

        ' Durchlaufe jede Zelle im Quellbereich

        For Each cell In Intersect(Target, sourceRange)

            ' Kopiere den Wert aus der Quellzelle in die entsprechende Zelle im Zielbereich

            targetRange.Cells(cell.Row - sourceRange.Cells(1).Row + 1, 1).Value = cell.Value

        Next cell



        Application.EnableEvents = True ' Aktiviere Event-Handling wieder

    End If

    

    tbl_Kalkulation.Protect ("20")

    

End Sub