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