Modificar macro para que cuente los valores sumados

Como siempre, requiriendo de tu ayuda para que me ayudes a modificar una de las macros que me creaste.

En esta ocasión necesito que la modifique para que me cuente la cantidad de valores que encuentra en una columna especifica. Anexo te envío la macro y un archivo donde ella debe mirar.

Saludos,

Máximo Gomez

Sub ResumenDiario()
'Por.Dante Amor
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Hoja1")
    u = h1.Range("B" & Rows.Count).End(xlUp).Row + 1
    h1.Range("C4:D197").ClearContents
    ruta = l1.Path
    'ChDir ruta
    archi = Dir(ruta & "\*.xls*")
    Do While archi <> ""
        n = archi
        m = l1.Name
        If archi <> l1.Name Then
            Set l2 = Workbooks.Open(ruta & "\" & archi)
            Set h2 = l2.ActiveSheet
            existe = False
            For Each h In l2.Sheets
                If h.Name = "Hoja1" Then
                    existe = True
                    Exit For
                End If
            Next
            If existe Then
                For i = 4 To h1.Range("B" & Rows.Count).End(xlUp).Row
                    If h1.Cells(i, "B") = l2.Sheets("Hoja1").[B5] Then
                        h1.Cells(i, "C") = h1.Cells(i, "C") + 1
                        h1.Cells(i, "D") = h1.Cells(i, "D") + l2.Sheets("Hoja1").[C5]
                        h1.Cells(i, "D") = h1.Cells(i, "D") + l2.Sheets("Hoja1").[C6]
                        h1.Cells(i, "D") = h1.Cells(i, "D") + l2.Sheets("Hoja1").[C7]
                        Exit For
                    End If
                Next
            End If
            l2.Close False
        End If
        archi = Dir()
    Loop
    MsgBox "Resumen diario terminado"
End Sub

Añade tu respuesta

Haz clic para o