EXCEL VBA, inserting blank row and shifting cells

Sub Addrisk()

Dim rActive As Range
Dim Count_Id_Column as long

Set rActive = ActiveCell

Application.ScreenUpdating = False

with thisworkbook.sheets(1) 'change to "sheetname" or sheetindex
    for i = 1 to .range("A1045783").end(xlup).row
        if 'something'  = 'something' then
            .range("A" & i).EntireRow.Copy 'add thisworkbook.sheets(index_of_sheet) if you copy from another sheet
            .range("A" & i).entirerow.insert shift:= xldown 'insert and shift down, can also use xlup
            .range("A" & i + 1).EntireRow.paste 'paste is all, all other defs are less.
            'change I to move on to next row (will get + 1 end of iteration)
            i = i + 1
        end if

            On Error Resume Next
                .SpecialCells(xlCellTypeConstants).ClearContents
            On Error GoTo 0

        End With
    next i
End With

Application.CutCopyMode = False
Application.ScreenUpdating = True 're-enable screen updates

End Sub

If you want to just shift everything down you can use:

Rows(1).Insert shift:=xlShiftDown

Similarly to shift everything over:

Columns(1).Insert shift:=xlShiftRight