Excel VBA insert Formulas below a table

Dear VBA Express community,

I would like to generate a code that automatically inserts Formulas and Text in the first 4 empty rows below a formerly created new worksheet (see picture). Does anyone have an idea how I can do this? The formulas are always the same.
Attachment 14521

Thank you very much in advance.

Best
Manito

Give us the code that adds the data to the new sheet and we'll add to it.
It might be something like:

Code:

---

Sub blah()
With Range("A9").CurrentRegion
  Z = .Columns(4).Address(0)
  With Cells(.Cells(.Cells.Count).Row + 1, 3)
    .Resize(4).Value = Application.Transpose(Array("Sum", "Avg", "Min", "Max"))
    .Offset(, 1).Formula = "=Sum(" & Z & ")"
    .Offset(1, 1).Formula = "=AVERAGE(" & Z & ")"
    .Offset(2, 1).Formula = "=Min(" & Z & ")"
    .Offset(3, 1).Formula = "=Max(" & Z & ")"
  End With
End With
End Sub

---

Thanks a lot for you quick answer. Here is the code

Sub extractJ2Dept()
'
' extractJ2Dept Macro
' Extracting the department selected in J2
'


'
Dim vNameDpt
vNameDpt = Sheets("HR").Range("J2").Value
Sheets.Add After:=Sheets(Sheets.Count)
'ActiveSheet.Select 'It's the sheet we are on so it's redundant
ActiveSheet.Name = vNameDpt
Sheets("HR").Select
Range("B1,C1,D1,F1").Select
'Range("F1").Activate no need to have a specific cell activated
Selection.Copy
Sheets(vNameDpt).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("HR").Columns("A:F").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("HR").Range("J1:J2"), CopyToRange:=Range("A1:D1"), _
Unique:=False
Columns("A:D").Select
Selection.Columns.AutoFit

End Sub

Difficult for me to test so test this for me:

Code:

---

Sub extractJ2Dept()
'
' extractJ2Dept Macro
' Extracting the department selected in J2
'


'
Dim vNameDpt
vNameDpt = Sheets("HR").Range("J2").Value
With Sheets.Add(After:=Sheets(Sheets.Count))
  .Name = vNameDpt
  Sheets("HR").Range("B1,C1,D1,F1").Copy .Range("A1")
  Sheets("HR").Columns("A:F").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("HR").Range("J1:J2"), CopyToRange:=.Range("A1:D1"), Unique:=False
  .Columns("A:D").Columns.AutoFit
  With .Range("A1").CurrentRegion
    Z = .Columns(4).Address(0)
    With Cells(.Cells(.Cells.Count).Row + 1, 3)
      .Resize(4).Value = Application.Transpose(Array("Sum", "Avg", "Min", "Max"))
      .Offset(, 1).Formula = "=Sum(" & Z & ")"
      .Offset(1, 1).Formula = "=AVERAGE(" & Z & ")"
      .Offset(2, 1).Formula = "=Min(" & Z & ")"
      .Offset(3, 1).Formula = "=Max(" & Z & ")"
    End With
  End With
End With
End Sub

---

Perfect, thank you very much for the great help. It works!
Have a great day.