Option
Explicit
Sub
TestRow()
Call
InsRow(ActiveSheet, 6)
End
Sub
Private
Function
InsRow(SH
As
Worksheet,
ByVal
myRow
As
Long
)
Dim
rngu
As
Range, rngS
As
Range
Dim
rngA
As
Range, rngC
As
Range
Dim
oDict
As
New
Scripting.Dictionary
Dim
i
As
Long
Set
oDict = CreateObject(
"Scripting.Dictionary"
)
Set
rngu = SH.UsedRange.Rows(myRow)
Set
rngS = rngu.SpecialCells(xlCellTypeFormulas)
For
Each
rngA
In
rngS.Areas
For
Each
rngC
In
rngA.Cells
oDict.Add rngC.Address, rngC.FormulaR1C1
Next
rngC
Next
rngA
SH.Rows(myRow).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
For
i = 0
To
oDict.Count - 1
SH.Range(oDict.Keys(i)).FormulaR1C1 = oDict.Items(i)
SH.Range(oDict.Keys(i)).Offset(1).FormulaR1C1 = oDict.Items(i)
Next
i
End
Function