Option
Explicit
Sub
FillSums()
Dim
sh
As
Worksheet
Dim
iRow
As
Integer
, iRows
As
Integer
Dim
strSum
As
String
Dim
Calc
As
XlCalculation
Set
sh = ActiveSheet
Calc = Application.Calculation
Application.Calculation = xlManual
iRows = sh.UsedRange.Rows.Count
strSum =
"=SUMIFS(R2C[-1]:R"
&
CStr
(iRows) &
"C[-1],R2C[-2]:R"
&
CStr
(iRows) &
"C[-2],RC[-2],R2C[-3]:R"
&
CStr
(iRows) &
"C[-3],RC[-3])"
For
iRow = 2
To
sh.UsedRange.Rows.Count
sh.Cells(iRow, 4).FormulaR1C1 = strSum
VBA.DoEvents
Next
Application.Calculation = Calc
End
Sub