excel 2016 splitting datasets creating new separate sheets

[kenyongraham]

Hi,

I am trying to split a worksheet that contains a list of data into seperate excel 2016 work sheets.

I have attached the workbook, I am attempting to put all the data categorised in column D on sheet 1 on separate sheets named 1, 2,3 4.... corresponding to the case integers ie. 1 to 23

There is an attached macro but I'm stumped on creatimg the loop.

I'm off to read my excel vba for dummies. Frustratingily I use to be able to achieve this.

Too many grey cells have gone to make way for invaluable facebook rubbish.

rgds

Kenyon

sheet sort.xlsmsheet sort.xlsm

[mdmackillop]

Welcome to VBAX
I still use the macro recorder. Here for info is the recorded macro and the edited version.
Note that there is no error checking for existing filters or output sheets which would affect the running of the macro.

Option Explicit

Sub Macro5()
    Sheets("Sheet1").Select
    Range("B10").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFilter
    ActiveWindow.SmallScroll Down:=-21
    ActiveSheet.Range("$B$10:$J$16282").AutoFilter Field:=3, Criteria1:="1"
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "01"
    Range("C11").Select
    Sheets("Sheet1").Select
    Selection.Copy
    Sheets("01").Select
    Range("B11").Select
    ActiveSheet.Paste
End Sub


Sub Test()
    Dim r As Range
    Dim i As Long, j As Long
    
    Set r = Sheets("Sheet1").Range("B10").CurrentRegion
    j = Application.Max(r.Columns(3))
        
    For i = 1 To j
    r.AutoFilter Field:=3, Criteria1:=i
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Format(i, "00")
    r.SpecialCells(xlCellTypeVisible).Copy Range("B11")
    Next i
    r.AutoFilter
End Sub

[snb]

or

Sub M_snb()
 Sheet1.Cells(1, 20) = [D10]
 
 For j = 1 To 23
    Sheets.Add(, Sheets(Sheets.Count)).Name = "S_" & j
    Sheet1.Cells(2, 20) = j
    Sheet1.Cells(10, 2).CurrentRegion.AdvancedFilter 2, Sheet1.Range("T1:T2"), Sheets("S_" & j).Cells(1)
 Next
  
End Sub