Excel VBA macro to Split Sheet into Multiple sheets based on column value Adapted from http://en.kioskea.net/faq/7053-excel-macro-to-create-new-workbook-and-copy-data By @mashhoodr @hu_me from MarketLytics

split_sheet_by_column_excel_macro.vbs

' Split Sheet into Multiple sheets based on column value
' Adapted from http://en.kioskea.net/faq/7053-excel-macro-to-create-new-workbook-and-copy-data
Sub details()    

Dim thisWB  As String    

Dim newWB As String    

    thisWB = ActiveWorkbook.Name    
        
    On Error Resume Next    
    Sheets("tempsheet").Delete    
    On Error GoTo 0    
        
    Sheets.Add    
    ActiveSheet.Name = "tempsheet"    
        
    Sheets("Sheet1").Select    
        
    If ActiveSheet.AutoFilterMode Then    
        Cells.Select    
            
        On Error Resume Next    
            
        ActiveSheet.ShowAllData    
            
        On Error GoTo 0    
        
    End If    
        
    Columns("B:B").Select    
    Selection.Copy    
        
    Sheets("tempsheet").Select    
    Range("A1").Select    
    ActiveSheet.Paste    
    Application.CutCopyMode = False    
        
    If (Cells(1, 1) = "") Then    
        lastrow = Cells(1, 1).End(xlDown).Row    
            
        If lastrow <> Rows.Count Then    
            Range("A1:A" & lastrow - 1).Select    
            Selection.Delete Shift:=xlUp    
        End If    
        
    End If    
        
    Columns("A:A").Select    
    Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _    
                CopyToRange:=Range("B1"), Unique:=True    
        
    Columns("A:A").Delete    
        
    Cells.Select    
    Selection.Sort _    
            Key1:=Range("A2"), Order1:=xlAscending, _    
            Header:=xlYes, OrderCustom:=1, _    
            MatchCase:=False, Orientation:=xlTopToBottom, _    
            DataOption1:=xlSortNormal    
        
    lMaxSupp = Cells(Rows.Count, 1).End(xlUp).Row    
        
    For suppno = 2 To lMaxSupp    
        
        Windows(thisWB).Activate    

        supName = Sheets("tempsheet").Range("A" & suppno)    
            
        If supName <> "" Then    
            

            Worksheets.Add (After:=Worksheets(Worksheets.Count)).Name = supName
           
            Sheets("Sheet1").Select    
            Cells.Select    
                
            If ActiveSheet.AutoFilterMode = False Then    
                Selection.AutoFilter    
            End If    
                
            Selection.AutoFilter Field:=2, Criteria1:="=" & supName, _    
                        Operator:=xlAnd, Criteria2:="<>"    
                
            lastrow = Cells(Rows.Count, 2).End(xlUp).Row    

            Rows("1:" & lastrow).Copy                    
           
            Sheets(supName).Select    
            ActiveSheet.Paste    

                
        End If    
        
    Next    
        
    Sheets("tempsheet").Delete    
        
    Sheets("Sheet1").Select    
    If ActiveSheet.AutoFilterMode Then    
        Cells.Select    
        ActiveSheet.ShowAllData    
    End If    

End Sub