Hallo,

in der folgenden Lösung werden die Fahrten-Summierung bereits nach dem Ändern der Tabelleninhalte berechnet:

Option Explicit

Dim bRunningCalc As Boolean

Private Sub CalcSum(Optional ByRef Target As Range)
    Dim sh As Worksheet
    Dim iRow As Integer, iRowSum As Integer
    Dim strStart As String
    Dim strTarget As String
    Dim iRides As Integer
    bRunningCalc = True
    Set sh = ActiveSheet 'ThisWorkbook.Sheets("Tabelle2")
    If Target Is Nothing Then
        For iRow = 2 To sh.UsedRange.Rows.Count
            strStart = sh.Cells(iRow, 1)
            strTarget = sh.Cells(iRow, 2)
            iRides = 0
            For iRowSum = 2 To sh.UsedRange.Rows.Count
                iRides = iRides + IIf(sh.Cells(iRowSum, 1) = strStart And sh.Cells(iRowSum, 2) = strTarget, Val(sh.Cells(iRowSum, 3)), 0)
            Next
            sh.Cells(iRow, 4).FormulaR1C1 = iRides
        Next
    Else
        iRow = Target.Row
        strStart = sh.Cells(iRow, 1)
        strTarget = sh.Cells(iRow, 2)
        iRides = 0
        For iRowSum = 2 To sh.UsedRange.Rows.Count
            iRides = iRides + IIf(sh.Cells(iRowSum, 1) = strStart And sh.Cells(iRowSum, 2) = strTarget, Val(sh.Cells(iRowSum, 3)), 0)
        Next
        For iRowSum = 2 To sh.UsedRange.Rows.Count
            If sh.Cells(iRowSum, 1) = strStart And sh.Cells(iRowSum, 2) = strTarget Then
                sh.Cells(iRowSum, 4).FormulaR1C1 = iRides
            End If
        Next
    End If
    bRunningCalc = False
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not bRunningCalc Then
        CalcSum Target
    End If
End Sub

Sub ReCalcSumAll()
    CalcSum
End Sub

VG, BigBen