Need to Customize an Exisitng Macro - Splits 1st Worksheet into Mutiple Worksheet Tabs

[usansay18]

Hi,

I got this macro that basically filters Column A in sheet 1 and copies and paste the data based on this criteria into multiple tabs, if that makes sense? So I have a bunch of columns of data and in column A is the Manager. But then it splits the data by manager into multiple tabs in the workbook and copies and paste the corresponding data in the rest of the columns. The macro works by filtering column A by the first manager, copying the data into a new worksheet. Then re-filtering column A by the 2nd manager, copying that data into another worksheet, so on and so forth till all the managers in column in the 1st tab are now copied into their own individual tabs in the workbook.

This macro is below...BUT, I need it to be customized a little bit. Right now, it copies the header (row 1) into each tab with the data below (row 2 & beyond). But, how can I copy both row 1 AND row 2 as the header and then copy each manager's data below into each tab?

ALSO, once it's done copying the data by manager into each tab, I need then the criteria column (column A) in each of these new worksheets to be deleted.

Can someone VBA savvy, add those 2 things to the code below?

Sub CopyByManager()
Dim FilterRng As Range
Dim TargetSh As Worksheet
Dim ManagerArr As Variant
Dim DestSh As Worksheet

Application.ScreenUpdating = False
Set TargetSh = Worksheets("Sheet1")
Set FilterRng = Range("A1", Range("A1").End(xlDown))

FilterRng.AdvancedFilter xlFilterCopy, copytorange:=TargetSh.Range("AZ1"), unique:=True
ManagerArr = TargetSh.Range("AZ2", TargetSh.Range("AZ1").End(xlDown))
Columns("AZ").ClearContents

For m = LBound(ManagerArr, 1) To UBound(ManagerArr, 1)
Set DestSh = Worksheets.Add(after:=Sheets(Sheets.Count))
DestSh.Name = ManagerArr(m, 1)
FilterRng.AutoFilter field:=1, Criteria1:=ManagerArr(m, 1)
FilterRng.SpecialCells(xlCellTypeVisible).EntireRow.Copy DestSh.Range("A1")

Next
FilterRng.AutoFilter
TargetSh.Activate
Application.ScreenUpdating = True
End Sub