При вводе некоторых ID не сошлись суммы Итог
Макрос в модуль Листа2
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("A")) Is Nothing Then
Application.EnableEvents = False
Dim FoundID As Range
Dim FAdr As String
Dim LastCol As Integer
Dim j As Integer
With Worksheets("Лист1")
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set FoundID = .Columns("A").Find(Target, , xlValues, xlWhole)
If Not FoundID Is Nothing Then
FAdr = FoundID.Address
j = 1
Do
Target.Offset(, j) = WorksheetFunction.Sum(.Range(.Cells(FoundID.Row, 3), _
.Cells(FoundID.Row, LastCol)))
Set FoundID = .Columns("A").FindNext(FoundID)
j = j + 1
Loop While FoundID.Address <> FAdr
Target.Offset(, j) = WorksheetFunction.Sum(Range(Cells(Target.Row, 2), _
Cells(Target.Row, 4)))
End If
End With
End If
Application.EnableEvents = True
End Sub