try
Sub ertert()
Dim i&, j&, Lr&, sm#
Lr = Cells(Rows.Count, 1).End(xlUp).Row
With Application
    .ScreenUpdating = False: .DisplayAlerts = False
    For i = 3 To Lr
        sm = Cells(i, 7): j = i
        Do While Cells(i, 1) = Cells(i + 1, 1)
            sm = sm + Cells(i + 1, 7)
            i = i + 1: If i > Lr Then Exit Do
        Loop
        If i > j Then
            Cells(j, 1).Resize(i - j + 1).Merge
            Cells(j, 7).Resize(i - j + 1).Merge
            Cells(j, 7).Value = sm
        End If
    Next i
    .ScreenUpdating = True: .DisplayAlerts = True
End With
End Sub