Provide user defined function for below vba code

please provide user defined function for below code this code is to generate sheet automatically of filter value. i also attached the file where this code apply

thanks



Option Explicit
Sub Copy_To_Workbooksmod()

Dim Rng As Range, x, i&
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set Rng = Sheets("ALL BANK 2012").Range("A1:G" & Sheets("ALL BANK 2012").Range("A" & Rows.Count).End(xlUp).Row)

Rng.Parent.AutoFilterMode = False

With CreateObject("Scripting.Dictionary")
.CompareMode = 1

x = Sheets("ALL BANK 2012").Range("A1:G" & Sheets("ALL BANK 2012").Range("A" & Rows.Count).End(xlUp).Row)
For i = 2 To UBound(x)
If Len(x(i, 6)) Then
If Not .Exists(Trim$((x(i, 6)))) Then
.Item(Trim$(x(i, 6))) = Empty

Rng.AutoFilter 6, "=" & Replace(Replace(Replace(x(i, 6), "~", "~~"), "*", "~*"), "?", "~?")

If Not Evaluate("ISREF('" & x(i, 6) & "'!A1)") Then
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = x(i, 6)
Else
Sheets(x(i, 6)).UsedRange.ClearContents
End If
With Worksheets(x(i, 6))
Rng.SpecialCells(xlCellTypeVisible).Copy
.Range("A1").PasteSpecial xlPasteValues
.Range("A1").PasteSpecial xlPasteFormats
.Columns.AutoFit
End With
Application.CutCopyMode = False

Rng.AutoFilter Field:=6
End If
End If
Next i
End With

Rng.Parent.AutoFilterMode = False

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub