dynamically insert heading rows in multiple sheets

[gleamng]

hi everyone, welcome to the month of september, ts 1st september here on this part of the world.

i found the vba below online, which apply filter on a column and paste result of a filter into a new worksheet and it suits my need. However, i need something more.
i want the macro to add heading to all tables generated to other sheets. for instance "gleam list for the month of august, 2020" gleam is one of the sheets generated. The date should be picked from a defined cell in "DATA Sheet" or the computer date

Sub filter()
Application.ScreenUpdating = False
Dim x As Range
Dim rng As Range
Dim last As Long
Dim sht As String

'specify sheet name in which the data is stored
sht = "DATA Sheet"

'change filter column in the following code
last = Sheets(sht).Cells(Rows.Count, "F").End(xlUp).Row
Set rng = Sheets(sht).Range("A1:F" & last)

Sheets(sht).Range("F1:F" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True

For Each x In Range([AA2], Cells(Rows.Count, "AA").End(xlUp))
With rng
.AutoFilter
.AutoFilter Field:=6, Criteria1:=x.Value
.SpecialCells(xlCellTypeVisible).Copy

Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
ActiveSheet.Paste
End With
Next x

' Turn off filter
Sheets(sht).AutoFilterMode = False

With Application
.CutCopyMode = False
.ScreenUpdating = True
End With

End Sub

Thank you all.

 

[NoSparks]

perhaps

For Each x In Range([AA2], Cells(Rows.Count, "AA").End(xlUp))
    With rng
        .AutoFilter
        .AutoFilter Field:=6, Criteria1:=x.Value
        .SpecialCells(xlCellTypeVisible).Copy
        
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
        ActiveSheet.Range("A2").PasteSpecial (xlPasteAll)
        ActiveSheet.Range("A1").Value = x.Value & " list for the month of " & Format(Date, "MMMM, YYYY")
    End With
Next x

 

[gleamng]

Thanks a million, it worked just as i wanted. I still need some additional help again, i want the font changed to tahoma, font size 20 and be centered as well.
Thank you once again for your help

 

[NoSparks]

try

For Each x In Range([AA2], Cells(Rows.Count, "AA").End(xlUp))
    With rng
        .AutoFilter
        .AutoFilter Field:=6, Criteria1:=x.Value
        .SpecialCells(xlCellTypeVisible).Copy
        
        'create and populate new sheets
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
        ActiveSheet.Range("A2").PasteSpecial (xlPasteAll)
        ActiveSheet.Range("A1").Value = x.Value & " list for the month of " & Format(Date, "MMMM, YYYY")
        'font & size
        Range("A1").Font.Name = "Tahoma"
        Range("A1").Font.Size = 20
        'alignment
        Range("A1:F1").MergeCells = True
        'position cursor
        Range("A1").Select
    End With
Next x