How to add blank rows below selected cell and keep formatting and formulas of above

Question

Sub addRows()
\' Adds new blank lines based on user input, keeping formatting and formulas of above.

Dim numRows     As Long
Dim raSource    As Range
Dim bResult