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!!!

How about (untested)

Sub InputFormula()
    Dim lr As Long
    Const sFormula1 As String = "=If(J2<>"""",H2,"""")"
    Const sFormula2 As String = "=If(Countif(B:B,H2)>0,Countif(B:B,H2),"""")"
    Const sFormula3 As String = "=If(Sumif(B:B,H2,C:C)>0,Sumif(B:B,H2,C:C),"""")"

    With Sheets("Result")
        lr = .Cells(.Rows.Count, "H").End(xlUp).Row + 1
        .Range("I2").Resize(lr).Formula = sFormula1
        .Range("J2").Resize(lr).Formula = sFormula2
        .Range("K2").Resize(lr).Formula = sFormula3
        .Range("I2").Resize(lr, 3).Value = .Range("I2").Resize(lr, 3).Value
    End With
End Sub