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
        Next

        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 _
                Destination:=wkbNew.Sheets(1).Range("A1")
            wkbNew.SaveAs strPath & varName & ".xlsx"
            wkbNew.Close
        
        Next
        
        .Range("a1").CurrentRegion.AutoFilter
        
    End With

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

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