Autofilter multiple worksheets copy data to new workbook and save

This requirement came from excel forum. its like a project work.
change your worksheet name & range accordingly.

This macro autofilter same value across multiple worksheets
Create a new workbook with same worksheets
Copy data to new workbook and save a workbook with name

Sub Mtest()
Dim Rng As Range
Dim ws As Worksheet
Dim shname As String
Dim i As Integer
Dim shn As Long
Dim mx As Variant
Dim x As Integer
Dim LR As Long
Dim sPath As String, sFileName As String
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = True
Set Rng = Sheets("Div").Range("A6:A" & Cells(Rows.Count, 1).End(xlUp).Row)
Set ws2 = Worksheets.Add(After:=Sheets(Sheets.Count))
With ws2
Rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("A1"), unique:=True
.Name = "Temp"
End With
Sheets("Temp").Columns("A").SpecialCells(xlCellTypeBlanks).Delete shift:=xlShiftUp
LR = Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LR
Cname = Sheets("Temp").Cells(i, 1)
Set ws2 = Workbooks.Add
mx = Array("Div", "bon", "right")
shn = 1 - LBound(mx)
For x = LBound(mx) To UBound(mx)
Sheets(x + shn).Name = mx(x)
Next x
m = ws2.Name
ThisWorkbook.Activate
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Temp" Then
ws.UsedRange.AutoFilter Field:=1, Criteria1:=Cname
ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy
shname = ws.Name
Application.Goto _
    Workbooks(m).Sheets(shname).Cells(1, 1)
ActiveSheet.Paste
ThisWorkbook.Activate
End If
Next ws
ws2.Activate
'Save the new workbook
sPath = ThisWorkbook.Path & "\"
'sPath = "C:\Users\MAHESH\Downloads\Delete\"
sFileName = Cname & ".xls"
Application.DisplayAlerts = False
ws2.SaveAs (sPath & sFileName)
ws2.Close True
ThisWorkbook.Activate
Next i
End Sub