在活动单元格下方插入带有公式的行

Question

I use this code to add a row below a selected cell. Is there any way to alter it so that it pastes formulas in columns E, G, and H, (for example: =IF(G4="","",G4*73)) but clears the contents of cells in Columns AD, F?

Sub BlankLine_copy()
lrow = Selection.Row()
Rows(lrow).Select
Selection.Copy
Rows(lrow + 1).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = True
'Selection.ClearContents
End Sub

Or maybe just insert the row below, but just copy the formulas down?

Answer 1

Frankly, I would have thought that there is a variation of PasteSpecial that copies formulas but not values, but if there is I didn't find it. The code below does the job, however. Please try it

Sub BlankLine_copy()

    Dim R As Long
    Dim C As Long

    R = Selection.Row
    With Rows(R)
        .Copy
        .Insert Shift:=xlDown
    End With
    Application.CutCopyMode = False

    R = R + 1
    For C = Cells(R, Columns.Count).End(xlToLeft).Column To 1 Step -1
        With Cells(R, C)
            If Not .HasFormula Then .ClearContents
        End With
    Next C
    Cells(R, 1).Select
End Sub

Answer 2

May be easier to do without loops like that

Sub Test()
Dim r As Long

r = Selection.Row
With Rows(r)
    .Copy
    .Insert Shift:=xlDown
End With
Application.CutCopyMode = False

Rows(r + 1).SpecialCells(xlCellTypeConstants).ClearContents
End Sub