Insert row + copy cell formula's error

you have some merged cells in column A, you can not select a single row with them.
eliminate column A, the your code works without errors
but you can solve with

Sub InsertRowsAndFillFormulas(Optional vRows As Long = 0)
   Dim x As Long
   r = ActiveCell.Row
   Range("B" & r & ":D" & r).Select
   If vRows = 0 Then
    vRows = Application.InputBox(prompt:= _
      "How many rows do you want to add?", Title:="Add Rows", _
      Default:=1, Type:=1) 'Default for 1 row, type 1 is number
    If vRows = False Then Exit Sub
   End If
   Range("B" & r + 1 & ":D" & r + vRows).Insert
   Selection.AutoFill Selection.Resize( _
     rowsize:=vRows + 1), xlFillDefault
End Sub