VBA code to include the headers in my VBA code and paste special to keep source formatting

[Xan]

I need help with my VBA code. My code autofilters Column D(Department) from row 19 and paste to different sheets by Department Name. However, Row 1 - 18 (Headers & body text) which are currently excluded in the new sheet. I need to include row 1- 18 and paste special to keep source formatting too. Please help

Function GetWorksheet(shtName As String) As Worksheet
    On Error Resume Next
    Set GetWorksheet = Worksheets(shtName)
End Function
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 = "Master list"

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

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

For Each x In Range([AA2], Cells(Rows.Count, "AA").End(xlUp))
If Not GetWorksheet(x.Text) Is Nothing Then
Sheets(x.Text).Delete
End If
With rng
.AutoFilter
.AutoFilter Field:=4, 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

 

[earthworm]

Instead of amending the above macro why not create a new one to simply copy and paste into desired sheet header and merge it in the last step of previous macro.