Code to continue formula in column when adding rows

I am currently using the following code to add new rows to my sheet:

Private Sub btAdd_Click()
If tbRowAdd < 1 Or tbRowAdd > 1500 Then
tbRowAdd.Text = "": MsgBox "You must enter a valid number from 1 to 1500."
Else
  Dim r%, c    As Range
  Dim i As Long
  If Not IsNumeric(tbRowAdd.Text) Then
    tbRowAdd.Text = "": MsgBox "You must enter a number."
  Else
    r = CInt(tbRowAdd.Text)
    Set c = ActiveCell.Offset(, 1 - ActiveCell.Column).Resize(, 6) 'cells A:F of the active row
    If WorksheetFunction.Median(1, 5000, r) = r And c.Parent.Name = "ReturnData" Then 'JAMES NOTE - This 5000 is the total limiting number of rows it will handle.
      Application.EnableEvents = False
      Application.ScreenUpdating = False
      c.Offset(1).EntireRow.Resize(r).Insert xlDown
      If Not c.Cells(1, 6).Formula Like "=IFERROR*" Then
        i = c.Row
        Do While i > 1
            i = i - 1
            If c.Offset(-(c.Row - i)).Cells(1, 6).Formula Like "=IFERROR*" Then
                c.Offset(-(c.Row - i)).Copy c.Offset(1).Resize(r)
                Exit Do
            End If
        Loop
      Else
        c.Copy c.Offset(1).Resize(r)
      End If
      c.Offset(1, 4).Resize(r, 1).ClearContents
      c.Offset(1, 3).Resize(r, 1).ClearContents
      vColf = Cells(Rows.Count, "F").End(xlUp).Row ' ID For keeping count of number of rows remaining. See ReturnData Worksheet code
      vColG = Cells(Rows.Count, "G").End(xlUp).Row ' ID For keeping count of number of rows remaining. See ReturnData Worksheet code
      
        Dim Zlast As Long
        Dim Zcolm As Range
        Dim awf As WorksheetFunction: Set awf = WorksheetFunction

        With Sheets("ReturnData")
            Zlast = .Cells(.Rows.Count, "Z").End(xlUp).Row
            If Zlast < 6 Then Zlast = 6
            Set Zcolm = .Range("Z6:Z" & Zlast)
            If awf.CountA(Zcolm) Then
                Zcolm.Copy
                Range("G" & vColG).Offset(1).PasteSpecial Paste:=xlPasteValues
                Zcolm.Value = ""
                Application.CutCopyMode = False
                RowStart = Cells(Rows.Count, "D").End(xlUp).Offset(1).Row
                RowEnd = Cells(Rows.Count, "G").End(xlUp).Row
                If RowEnd - RowStart >= "1" Then
                    Cells.Range("D" & RowStart, "D" & RowEnd) = Date
                End If
            End If
        End With
        
      Application.EnableEvents = True
      Application.ScreenUpdating = True
      Unload Me
    Else
      MsgBox "An error has occured. You have likely exceeded the maximum amount of records the system is allowed to handle at one time (5000). We recommend breaking it down into seperate actions. If the error continues please contact the Administrator at [email protected]"
    End If
  End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

The code continues the formulas in columns A, B C & F in the newly added rows. I have just recently added formulas in the K column. How can I get it to continue the code in that column also?

Thanks,
James

The sheet is very complicated and has a lot going on. I tried using tables once and it messed everything up. This has been working great for me, I just need to extend it to work on the K Column also.

I just figure out how to get it to copy down the formula in the F column by changing the 6 to 11 on lines 11, 16 and 20 (see bold).

However it now for some reason is also copying the data in column G to all the new rows it adds. How can I keep column G clear in all the newly added rows?

Private Sub btAdd_Click()
If tbRowAdd < 1 Or tbRowAdd > 1500 Then
tbRowAdd.Text = "": MsgBox "You must enter a valid number from 1 to 1500."
Else
  Dim r%, c    As Range
  Dim i As Long
  If Not IsNumeric(tbRowAdd.Text) Then
    tbRowAdd.Text = "": MsgBox "You must enter a number."
  Else
    r = CInt(tbRowAdd.Text)
    Set c = ActiveCell.Offset(, 1 - ActiveCell.Column).Resize(, 11) 'cells A:F of the active row
    If WorksheetFunction.Median(1, 5000, r) = r And c.Parent.Name = "ReturnData" Then
      Application.EnableEvents = False
      Application.ScreenUpdating = False
      c.Offset(1).EntireRow.Resize(r).Insert xlDown
      If Not c.Cells(1, 11).Formula Like "=IFERROR*" Then
        i = c.Row
        Do While i > 1
            i = i - 1
            If c.Offset(-(c.Row - i)).Cells(1, 11).Formula Like "=IFERROR*" Then
                c.Offset(-(c.Row - i)).Copy c.Offset(1).Resize(r)
                Exit Do
            End If
        Loop
      Else
        c.Copy c.Offset(1).Resize(r)
      End If
      c.Offset(1, 4).Resize(r, 1).ClearContents
      c.Offset(1, 3).Resize(r, 1).ClearContents
      vColf = Cells(Rows.Count, "F").End(xlUp).Row ' ID For keeping count of number of rows remaining. See ReturnData Worksheet code
      vColG = Cells(Rows.Count, "G").End(xlUp).Row ' ID For keeping count of number of rows remaining. See ReturnData Worksheet code
      
        Dim Zlast As Long
        Dim Zcolm As Range
        Dim awf As WorksheetFunction: Set awf = WorksheetFunction

        With Sheets("ReturnData")
            Zlast = .Cells(.Rows.Count, "Z").End(xlUp).Row
            If Zlast < 6 Then Zlast = 6
            Set Zcolm = .Range("Z6:Z" & Zlast)
            If awf.CountA(Zcolm) Then
                Zcolm.Copy
                Range("G" & vColG).Offset(1).PasteSpecial Paste:=xlPasteValues
                Zcolm.Value = ""
                Application.CutCopyMode = False
                RowStart = Cells(Rows.Count, "D").End(xlUp).Offset(1).Row
                RowEnd = Cells(Rows.Count, "G").End(xlUp).Row
                If RowEnd - RowStart >= "1" Then
                    Cells.Range("D" & RowStart, "D" & RowEnd) = Date
                End If
            End If
        End With
        
      Application.EnableEvents = True
      Application.ScreenUpdating = True
      Unload Me
    Else
      MsgBox "An error has occured. You have likely exceeded the maximum amount of records the system is allowed to handle at one time (5000). We recommend breaking it down into seperate actions. If the error continues please contact the Administrator at [email protected]"
    End If
  End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub