Macro para Stock

Vemos que se puede hacer, mi mail es isenrey(a)yahoo. Es

Como sugerencia, lo ideal sería actualizar el stock cada ve que entra o sale un producto, pero conservando tu esquema aquí te dejo el código. Lo único que debes hacer es pegarlo en un módulo.
El proceso de actualización se denmora, y se demorará más, mientras más entradas y salidas tengas.
Para que no desesperes sin saber cuanto lleva, le he puesto un contador.
Si tomas la alternativa de actualizar cada vez que entra o sale un producto (es más eficiente) me avisas y ahí vemos como lo implementamos.
EL CÓDIGO (Está acondicionado para tu documento)

Sub Rectángulo_AlHacerClic()
  Dim i As Double
  Dim dblFil As Double
  Dim dblNFilas As Double
  dblNFilas = Hoja2.Range("C65535").End(xlUp).Row
  For i = 3 To dblNFilas
    'Extraer el stock inicial
     dblFil = fcnBuscar(Hoja2, "C", Hoja5.Cells(i, 2), 3)
     Hoja5.Cells(i, 4) = Hoja2.Cells(dblFil, 2)
    'Sumar las entradas
    dblFil = 2
    Do Until (dblFil = 0)
        dblFil = fcnBuscar(Hoja3, "D", Hoja5.Cells(i, 2), dblFil + 1)
        If (dblFil <> 0) Then
            Hoja5.Cells(i, 4) = Hoja5.Cells(i, 4) + Hoja3.Cells(dblFil, 6)
        End If
    Loop
    'Restar las salidas
    dblFil = 2
    Do Until (dblFil = 0)
        dblFil = fcnBuscar(Hoja4, "D", Hoja5.Cells(i, 2), dblFil + 1)
        If (dblFil <> 0) Then
            Hoja5.Cells(i, 4) = Hoja5.Cells(i, 4) - Hoja4.Cells(dblFil, 6)
        End If
    Loop
    Hoja5.Range("E3") = Round(100 * ((i - 3) / (dblNFilas - 3))) & " %"
  Next
  Hoja5.Range("E3") = ""
End Sub
Function fcnBuscar(hojaBusq As Worksheet, _
              strColumna As String, _
              valor, _
              Optional dblFilaIni As Double = 1) As Double
    Dim strRango As String
    Dim resulta As Range
    fcnBuscar = 0
    'Buscar en la primera fila
    Set resulta = hojaBusq.Range(strColumna & dblFilaIni).Find(What:=valor, LookIn:=xlValues, LookAt:=xlWhole)
    'Si no hay asierto
    If resulta Is Nothing Then
        'Buscar en las siguientes filas
        strRango = strColumna & dblFilaIni & ":" & _
                   strColumna & hojaBusq.Range(strColumna & "65535").End(xlUp).Row + 1
        'MsgBox strRango
        Set resulta = hojaBusq.Range(strRango).Find(What:=valor, LookIn:=xlValues, LookAt:=xlWhole)
        If Not resulta Is Nothing Then
            fcnBuscar = resulta.Row
        End If
    Else
        'si hay asierto, retornar la fila
        fcnBuscar = resulta.Row
    End If
End Function