Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, ActiveSheet.UsedRange.Columns("A:D")) Is Nothing Then
        Wood
    End If
End Sub

Sub Wood()
    With Sheets("Склад")
        Dim arr As Variant
        arr = .Range(.Cells(3, 1), .Cells(.Rows.Count, 1).End(xlUp).Cells(1, 4))
        
        Dim dic As Object
        Set dic = CreateObject("Scripting.Dictionary")
        Dim yy As Long
        Dim sKey As String
        For yy = 1 To UBound(arr, 1)
            sKey = myKey(arr(yy, 1), arr(yy, 2), arr(yy, 3))
            If Not dic.Exists(sKey) Then dic.Item(sKey) = dic.Count + 1
        Next
        If dic.Count > 0 Then
            Dim yo As Long
            Dim brr As Variant
            Dim krr As Variant
            Dim orr As Variant
            ReDim orr(1 To dic.Count, 1 To 4)
            krr = dic.Keys()
            For yy = 1 To dic.Count
                brr = Split(krr(yy - 1), vbTab)
                For yo = 0 To UBound(brr, 1)
                    orr(yy, yo + 1) = brr(yo)
                Next
            Next
            For yy = 1 To UBound(arr, 1)
                sKey = myKey(arr(yy, 1), arr(yy, 2), arr(yy, 3))
                yo = dic.Item(sKey)
                orr(yo, 4) = orr(yo, 4) + arr(yy, 4)
            Next
            
            Application.EnableEvents = False
            Dim Application_Calculation As Long
            Application_Calculation = Application.Calculation
            Application.Calculation = xlCalculationManual
            .Range("J3").Resize(.Rows.Count - 3, UBound(orr, 2)).ClearContents
            Dim rOut As Range
            Set rOut = .Range("J3").Resize(UBound(orr, 1), UBound(orr, 2))
            rOut = orr
            
            With .Sort
                .SortFields.Clear
                .SortFields.Add Key:=rOut.Columns(1), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
                .SortFields.Add Key:=rOut.Columns(2), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
                .SortFields.Add Key:=rOut.Columns(3), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
                .SetRange rOut
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            
            Application.Calculation = Application_Calculation
            Application.EnableEvents = True
        End If
    End With
End Sub
Private Function myKey(ByVal xx As String, ByVal yy As String, ByVal zz As String) As String
    myKey = Join(Array(xx, yy, zz), vbTab)
End Function