EXCEL VBA, inserting blank row and shifting cells - excel

Question

I'm having trouble entering an entire blank row. I'm trying to shift Columns A-AD (four columns past Z).
Currently cells A-O has content. Cells O-AD are blank. But I'm running a macro to put data to the right of the current data (column O).
I can insert a row using
dfind1.Offset(1).EntireRow.Insert shift:=xlDown
but it only seems to shift down from A-O. I've manage to shift down O-AD using a for loop
dfind1 as Range
For d = 1 To 15
dfind1.Offset(2, (d + 14)).Insert shift:=xlDown
Next d
Is there a way to shift down 30 cells VS 15? Similarly, I want to shift 15 to the cells to the right. Currently I have another for loop setup for that.
As for the rest of the code, its below. Basically merging two excel sheets bases on finding a match in column A. I've marked the problem area. The rest of the code works for the most part.
Sub combiner()
Dim c As Range, d As Long, cfind As Range, x, y, zed, dest As Range, cfind1 As Range, dfind As Range, _
dfind1 As Range, crow, x_temp, y_temp
On Error Resume Next
Worksheets("sheet3").Cells.Clear
With Worksheets("sheet1")
.UsedRange.Copy Worksheets("sheet3").Range("a1")
End With
With Worksheets("sheet2")
For Each c In Range(.Range("a3"), .Range("a3").End(xlDown))
x = c.Value
y = c.Next
Set cfind = .Cells.Find(what:=y, lookat:=xlWhole)
.Range(cfind.Offset(0, -1), cfind.End(xlToRight)).Copy
With Worksheets("sheet3")
Set dfind1 = .Cells.Find(what:=x, lookat:=xlWhole)
If dfind1 Is Nothing Then GoTo copyrev
'**************************************************************
'**************************************************************
'This is the problem Area
'I'm basically having trouble inserting a blank row
dfind1.Offset(1).EntireRow.Insert shift:=xlDown
For d = 1 To 15
dfind1.Offset(1).Insert shift:=xlToRight
Next d
For d = 1 To 15
dfind1.Offset(2, (d + 14)).Insert shift:=xlDown
Next d
'**************************************************************
'**************************************************************
End With 'sheet3
GoTo nextstep
copyrev:
With Worksheets("sheet3")
x_temp = .Cells(Rows.Count, "A").End(xlUp).Row
y_temp = .Cells(Rows.Count, "P").End(xlUp).Row
If y_temp > x_temp Then GoTo lr_ed
lMaxRows = x_temp
GoTo lrcont
lr_ed:
lMaxRows = y_temp
lrcont:
.Range(("P" & lMaxRows + 1)).PasteSpecial
Worksheets("sheet2").Range(cfind.Offset(0, -1), cfind.Offset(0, 0)).Copy
.Range(("A" & lMaxRows + 1)).PasteSpecial
End With 'sheet3
nextstep:
Next
lngLast = Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("Sheet3").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A1:A2" & lngLast), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("B3:Z" & lngLast)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With 'sheet2
Application.CutCopyMode = False
End Sub

Answer 1

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

Answer 2

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