Split Master Sheet into Separate Tabs based on data & rename tab

This assumes that your table on the activesheet starts in cell A1:

Sub SplitDataBase()
    Dim C As Range
    Dim DSh As Worksheet
    Dim ASh As Worksheet
    Dim strName As String
    Dim rngC As Range
    Dim lngKC As Long
    
    'Optional code to select key column
    'Set rngC = Application.InputBox("Select a cell in the key column", Type:=8)
    'lngKC = rngC.Column
    
    'Code to specify key column (4 \is column D)
    lngKC = 4 'Key Column 1 = A, 2 = B etc.
    
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    Set ASh = ActiveSheet
    Set rngC = ASh.Range("A1").CurrentRegion
    With ASh
        rngC.Columns(lngKC).AdvancedFilter Action:=xlFilterCopy, _
            CopyToRange:=.Cells(.Rows.Count, lngKC).End(xlUp)(3), Unique:=True
        With .Cells(.Rows.Count, lngKC).End(xlUp).CurrentRegion
            For Each C In .Cells.Offset(1).Resize(.Cells.Count - 1, 1)
                If C.Value <> "" Then
                    On Error Resume Next
                    Worksheets(C.Value).Delete
                    On Error GoTo 0
                    Set DSh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
                    DSh.Name = C.Value
                    rngC.AutoFilter Field:=lngKC, Criteria1:=C.Value & "*"
                    rngC.SpecialCells(xlCellTypeVisible).Copy DSh.Range("A1")
                    rngC.AutoFilter
                    DSh.Cells.EntireColumn.AutoFit
                End If
            Next C
            .Clear
        End With
    End With
    
    If MsgBox("Export the new sheets to files?", vbYesNo) = vbYes Then
        For Each DSh In ActiveWorkbook.Worksheets
            If DSh.Name <> ASh.Name Then
                DSh.Move
                ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Workbook " & ActiveSheet.Name & ".xlsx"
                ActiveWorkbook.Close
            End If
        Next DSh
    End If

    Application.DisplayAlerts = True
    Application.EnableEvents = True
    
End Sub