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