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