Sub Raschet()
Dim i As Long
Dim iLastRow As Long
Dim Diapazon As Range
Dim FoundMaterial As Range
Dim FAdr As String
Dim iSumma As Double
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
Set Diapazon = Range("A3:A" & iLastRow)
For i = 36 To 38
iSumma = 0
Set FoundMaterial = Diapazon.Find(Cells(i, 2), , xlValues, xlWhole)
FAdr = FoundMaterial.Address
Do
iSumma = iSumma + Cells(FoundMaterial.Row, 3) / 1000 * _
Cells(FoundMaterial.Row, 4) / 1000 * Cells(FoundMaterial.Row, 6)
Set FoundMaterial = Diapazon.FindNext(FoundMaterial)
Loop While FoundMaterial.Address <> FAdr
Cells(i, 4) = WorksheetFunction.RoundUp(iSumma, 2)
Next
End Sub
По аналогии на Лист1 сделайте кнопку и привяжите к ней макрос
Код
Sub Raschet_forЛист1()
Dim i As Long
Dim iLastRow As Long
Dim Diapazon As Range
Dim FoundMaterial As Range
Dim FAdr As String
Dim iSumma As Double
iLastRow = Range("A13").End(xlDown).Row
Set Diapazon = Range("A13:A" & iLastRow)
For i = 21 To 23
iSumma = 0
Set FoundMaterial = Diapazon.Find(Cells(i, 2), , xlValues, xlWhole)
FAdr = FoundMaterial.Address
Do
iSumma = iSumma + Cells(FoundMaterial.Row, 3) / 1000 * _
Cells(FoundMaterial.Row, 4) / 1000 * Cells(FoundMaterial.Row, 6)
Set FoundMaterial = Diapazon.FindNext(FoundMaterial)
Loop While FoundMaterial.Address <> FAdr
Cells(i, 4) = WorksheetFunction.RoundUp(iSumma, 2)
Next
End Sub