Split Excel Table - each row of table becomes a separate sheet in your workbook

gistfile1.txt

Option Explicit
Sub Split_Excercise()
    Dim wsData As Worksheet, wsNames As Worksheet, wsFilter As Worksheet
    Dim Datarng As Range, FilterRange As Range
    Dim rowcount As Long
    Dim FilterCol As Variant
    
    On Error GoTo progend
    
'******************************************************************************************************

'your master sheet
    Set wsData = ThisWorkbook.Worksheets("Live")
    
'Column you are filtering
    FilterCol = "A"
    
'******************************************************************************************************
    
    With Application
        .ScreenUpdating = False: .DisplayAlerts = False
    End With
'add filter sheet
    Set wsFilter = ThisWorkbook.Worksheets.Add
    
    With wsData
        .Activate
'add password if needed
        .Unprotect Password:=""
        
        Set Datarng = .Range("A1").CurrentRegion
        
'extract values from FilterCol'to filter sheet
        .Cells(1, FilterCol).Resize(Datarng.Rows.Count).AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=wsFilter.Range("A1"), Unique:=True
        
        rowcount = wsFilter.Cells(wsFilter.Rows.Count, "A").End(xlUp).Row
'set Criteria
        wsFilter.Range("B1").Value = wsFilter.Range("A1").Value
        
        For Each FilterRange In wsFilter.Range("A2:A" & rowcount)
'check for blank cell in range
            If FilterRange.Value <> "" Then
'add the FilterRange to criteria
                wsFilter.Range("B2").Value = FilterRange.Value
'check if sheet exists
                If Not Evaluate("ISREF('" & FilterRange.Value & "'!A1)") Then
'add new sheet
                    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = FilterRange.Value
                End If
'set object variable to sheet
                Set wsNames = Worksheets(FilterRange.Value)
'clear sheet
                wsNames.UsedRange.Clear
'copy data
                Datarng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsFilter.Range("B1:B2"), _
                CopyToRange:=wsNames.Range("A1"), Unique:=False
            End If
'autofit columns
            wsNames.UsedRange.Columns.AutoFit
'clear from memory
            Set wsNames = Nothing
        Next
        .Select
    End With
progend:
    wsFilter.Delete
    With Application
        .ScreenUpdating = True: .DisplayAlerts = True
    End With
    If Err <> 0 Then
        MsgBox (Error(Err)), vbCritical, "Error"
        Err.Clear
    End If
End Sub