Ventiler une base en feuilles et onglets - VBA

Sub EclaterClasseursV3()
'archive :JM | 2013
'auteur macro d'origine: JoeMo - avril 2013
Dim lR&, vA As Variant, d As Object, JT As Variant, Wsht As Worksheet, wb As Workbook
Dim Chemin As String
Chemin = ThisWorkbook.Path & "\"
Set Wsht = Sheets("TEST")
If Wsht.AutoFilterMode Then Wsht.Range("A9").AutoFilter
lR = Wsht.Range("N" & Rows.Count).End(xlUp).Row
vA = Wsht.Range("N10", "N" & lR).Value
Set d = CreateObject("Scripting.dictionary")
d.RemoveAll
For i = LBound(vA, 1) To UBound(vA, 1)
    If Not d.exists(vA(i, 1)) Then d.Add vA(i, 1), i
Next i
JT = d.keys
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = LBound(JT) To UBound(JT)
    With Wsht
        .Range("A9").AutoFilter field:=14, Criteria1:=JT(i)
        Wsht.UsedRange.Copy
        Set wb = Workbooks.Add(xlWBATWorksheet)
        With wb.Sheets(1)
            .Name = JT(i)
        With .Range("A1")
            .PasteSpecial Paste:=xlPasteColumnWidths
            .PasteSpecial Paste:=xlPasteAllUsingSourceTheme
        End With
        wb.SaveAs Chemin & wb.Sheets(1).Name & ".xlsx", 51
        wb.Close True
        Application.CutCopyMode = False
        Wsht.Select
        End With
    End With
Next i
If Wsht.AutoFilterMode Then Wsht.Range("A9").AutoFilter
Application.DisplayAlerts = True
End Sub