Auto-copy multiple formula when multiple rows are inserted

[InsertName]

I need some advice on vba for a worksheet I am using. The sheet is basically a template that will be populated by users, and as such I don't know the eventual size of the data set to be input. I want to include the option for users to insert rows anywhere in the table, but when I try this the columns which contain formulae are left blank and the users would have to fill them themselves.

What I'd like to happen is for the action of inserting new rows to automatically populate the new rows with the formula in the row above.

I've looked around online and found a few options for how to do it via a macro, but nothing seems to work exactly as desired. The closest I have managed to come to the working vba is below. This seems to worked but only for one row at a time - can anyone tell me how to amend this vba such that I can insert multiple rows at the same time, and the formula auto-populates for all of the new rows?

Thanks!



Option Explicit

Dim RowsCount As Long ' Variable to track number of rows used in sheet


Private Sub Worksheet_Activate()
RowsCount = Me.UsedRange.Rows.Count
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo EH
' Detect whole row changed
If Target.Columns.Count = Me.Columns.Count Then
' Detect Extra Row
If RowsCount = Me.UsedRange.Rows.Count - 1 Then
' Copy Formulas and Format new row
Application.EnableEvents = False
If Target.Row > 1 Then
Target.Offset(-1, 0).Copy
Target.PasteSpecial xlPasteFormulas, xlPasteSpecialOperationNone, False, False
Target.PasteSpecial xlPasteFormats, xlPasteSpecialOperationNone, False, False
Application.CutCopyMode = False
End If
End If
RowsCount = Me.UsedRange.Rows.Count
End If

EH:
Application.EnableEvents = True
End Sub

 

[Fluff]

Hi & welcome to the board
How about this

Private Sub Worksheet_Change(ByVal Target As Range)

   Dim Rws As Long
   
   On Error GoTo EH
   ' Detect whole row changed
   If Target.Columns.Count = Me.Columns.Count Then
      ' Detect Extra Row
      Rws = Target.CountLarge / Me.Columns.Count
      If rowscount < Me.UsedRange.Rows.Count Then
         ' Copy Formulas and Format new row
         Application.EnableEvents = False
         If Target.Row > 1 Then
            Target.Offset(-1, 0).Resize(Rws + 1).FillDown
         End If
      End If
      rowscount = Me.UsedRange.Rows.Count
   End If
   
EH:
Application.EnableEvents = True
End Sub

 

[InsertName]

Thanks Fluff! That's working perfectly.

 

[Fluff]

Glad to help & thanks for the feedback