VBA – create separate spreadsheets from a filtered table

The task is relatively simple and until now it was always performed by some poor admin soul. There is a large table that needs to be filtered based on a simple criteria and each view has to be saved as a new spreadsheet.

The code is as simple as the task (and as my coding skills) so I would love to get some feedback about any tricks I might have missed to make it more robust or “best practices” advice.

Option Explicit

Sub SplitWorksheet()

    Dim d As Long
    Dim dctList As Object
    Dim varList As Variant
    Dim varName As Variant
    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim rng As Range
    Dim wkbNew As Workbook
    Dim strPath As String

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("Data")
    Set rng = wks.Range("A1").CurrentRegion
    strPath = Application.ThisWorkbook.Path & "Distribution"
    Set dctList = CreateObject("Scripting.Dictionary")
    dctList.CompareMode = vbTextCompare

    With wks
        varList = .Range(.Cells(6, "H"), .Cells(Rows.Count, "H").End(xlUp)).Value2

        For d = LBound(varList) To UBound(varList)
            dctList.Item(varList(d, 1)) = vbNullString

        For Each varName In dctList
            .Range("a1").CurrentRegion.AutoFilter Field:=8, Criteria1:="=" & varName, Operator:=xlFilterValues
            Set wkbNew = Workbooks.Add
            .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
            wkbNew.SaveAs strPath & varName & ".xlsx"
    End With

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox "All done, individual spreadsheets have been saved", vbOKOnly, "Great success!"
End Sub