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

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 As Boolean
Set raSource = ActiveCell.EntireRow
numRows = InputBox("Enter number of rows to insert. Rows will be added above the highlighted row.")
On Error Resume Next
raSource.Copy
bResult = Range(raSource.Offset(1, 0), raSource.Offset(numRows,
0)).EntireRow.Insert(Shift:=xlShiftDown, CopyOrigin:=xlFormatFromLeftOrAbove)
Application.CutCopyMode = False
If Not bResult Then
MsgBox "Inserting rows failed!", vbExclamation
End If
End Sub
The code works how I want it to except it keeps all the data from the selected row and pastes it to new rows. I want to only keep the formatting and formulas of the selected row and insert the new row below.

Answer 1

Try this code. I have linkedan example workbook as well. Let me know if this works.
Download example workbook here
Sub insertXRows()
Dim cell As Range
Dim lngRows As Long
Application.ScreenUpdating = False
'ERROR HANDLER
On Error GoTo ErrMsg
'#CHECK IF ACTIVE CELL IS IN A TABLE
'SOURCE: https://stackoverflow.com/a/34077874/10807836
Dim r As Range
Dim lo As ListObject
Set r = ActiveCell
Set lo = r.ListObject
If Not lo Is Nothing Then
Select Case lo.Name
Case "Table1"
If r.Row = lo.Range.Row Then
MsgBox "In Table1 Header"
Else
MsgBox "In Table1 Body"
End If
Case "SomeOtherTable"
'...
End Select
Else
MsgBox "Active cell is not in any table. Please select a cell in an active table and retry."
Exit Sub
End If
'MSGBOX to enter #rows to insert
lngRows = InputBox("Enter number of rows to insert. Rows will be added above the highlighted row.")
'CODE TO INSERT X Rows
Selection.Resize(lngRows).EntireRow.Insert
For Each cell In Intersect(ActiveSheet.UsedRange, Selection.Offset(-1, 0).EntireRow)
If cell.HasFormula Then
cell.Copy cell.Offset(1, 0)
End If
Next
Application.ScreenUpdating = True
'ERROR MSG
On Error GoTo 0
Exit Sub
ErrMsg: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure insertX, line " & Erl & "."
End Sub