Werte aus einer Tabelle vergleichen, einlesen und addieren

Sub Summierung()
    Dim ws1 As Worksheet, ws2 As Worksheet, rngNames As Range, rngSearch As Range, cell As Range, c As Range
    Set ws1 = Worksheets(1) 'Übersichtstabelle  
    Set ws2 = Worksheets(2) 'Ausleitungstabelle  
    Set rngNames = ws1.Range("A2", ws1.Cells(Rows.Count, 1).End(xlUp))  ' Bereich der Namen in der Übersichtstabelle  
    Set rngSearch = ws2.Range("B2", ws2.Cells(Rows.Count, 2).End(xlUp)) ' Bereich der Namen in der Ausleitungstabelle  
    ' Für jeden Namen in der Übersichtstabelle  
    For Each cell In rngNames
        'Suche den Namen in der Ausleitungstabelle  
        Set c = rngSearch.Find(cell.Value, LookIn:=xlValues, Lookat:=xlWhole)
        ' Wenn der Name gefunden wurde ...  
        If Not c Is Nothing Then
            firstAddress = c.Address
            ' Suche so lange weiter nach dem Namen bis er nicht mehr gefunden wird  
            Do
                ' Addiere die Werte der Zellen  
                cell.Offset(0, 3).Value = Int(cell.Offset(0, 3).Value) + Int(c.Offset(0, 6).Value)
                'Finde den nächsten Treffer  
                Set c = rngSearch.FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    Next
End Sub