Insert three formulas one in each column paste values

Hi.
I need to put a formula in each row and then drag down, and paste values​​.

tried the code below, but it was cool.

Sub InputFormula()
Dim lr As Range
    'cell I1=If(J2<>"""",H2,"""")
    'celula J1=If(Countif(B:B,H2)>0,Countif(B:B,H2)
    'celula K1=If(Sumif(B:B,H2,C:C)>0,Sumif(B:B,H2,C:C),"""")
    
    With Sheets("Result")
    Set lr = .Cells(.Rows.Count, "H").End(xlUp).Offset(, 1)
    With .Range("I2", lr)
        .Formula = "=If(J2<>"""",H2,"""")"
        .Value = .Value 'if you want to convert the formulae to hard values.
    End With
    Set lr = .Cells(.Rows.Count, "H").End(xlUp).Offset(, 2)
    With .Range("J2", lr)
        .Formula = "=If(Countif(B:B,H2)>0,Countif(B:B,H2),"""")"
        .Value = .Value
    End With
    
    Set lr = .Cells(.Rows.Count, "H").End(xlUp).Offset(, 3)
    With .Range("K2", lr)
        .Formula = "=If(Sumif(B:B,H2,C:C)>0,Sumif(B:B,H2,C:C),"""")"
        .Value = .Value
    End With
    End With

End Sub

if someone can improve this code, I'd be grateful!
Thank you!!!