how do i paste column widths and table settings to new workbook which is created based off of a unique value in original workbook

Question

I want to add a paste column widths some how as well as a paste table formats but cant seem to figure it out

Private Sub SplitWorksheet(ByVal Category_Name As Variant)

Dim wbTarget As Workbook

Set wbTarget = Workbooks.Add

        

With wsSource
    
    With .Range(.Cells(1, 1), .Cells(LastRow, LastColumn))
        .AutoFilter .Range("I1").Column, Category_Name
        
        .Copy
        
        'wbTarget.Worksheets(1).PasteSpecial xlValues
        wbTarget.Worksheets(1).Paste
        wbTarget.Worksheets(1).Name = Category_Name
       
        
        
    End With
    
End With

Answer 1

Copy Filtered Excel Table to Another Workbook

Option Explicit

Sub SplitWorksheetTest()
     SplitWorksheet 3 ' "A"
End Sub

Private Sub SplitWorksheet(ByVal Category_Name As Variant)
    ' 'wsSource' is the code name of a worksheet in 'ThisWorkbook',
    ' the workbook containing this code.
    
    ' Source
    Const stName As String = "Table1"
    ' Destination
    Const dtName As String = "Table1"
    Const dtFirstCellAddress As String = "A1"
    ' Both
    Const ColName As String = "Category"
    
    Application.ScreenUpdating = False
    
    ' Source
    With wsSource.ListObjects(stName)
        If .AutoFilter.FilterMode Then .AutoFilter.ShowAllData
        If Application.CountIf(.ListColumns(ColName) _
                .DataBodyRange, Category_Name) = 0 Then
            'Application.ScreenUpdating = True ' before the message box
            'MsgBox "Category '" & Category_Name & "' not found.", vbExclamation
            Exit Sub
        End If
        .Range.Copy
    End With
    
    ' Destination
    With Workbooks.Add(xlWBATWorksheet).Worksheets(1) ' single worksheet
        .Name = Category_Name
        With .Range(dtFirstCellAddress)
            .PasteSpecial
            .PasteSpecial xlPasteColumnWidths
             Application.CutCopyMode = False
        End With
        With .ListObjects(1)
            If StrComp(.Name, dtName, vbTextCompare) <> 0 Then .Name = dtName
            .Range.AutoFilter .ListColumns(ColName).Index, "<>" & Category_Name
            With .DataBodyRange.SpecialCells(xlCellTypeVisible)
                .ListObject.AutoFilter.ShowAllData ' mandatory before delete,...
                .Delete xlShiftUp ' ... or it asks to delete entire rows...
            End With ' ... and even errors out if 'No' is selected.
            Application.Goto .Range.Cells(1), True ' scroll to 1st table cell
        End With
        With .Parent ' Workbook
            .Saved = True ' to easily close without confirmation while testing
            '.SaveAs "C:\Test\" & Category_Name & ".xlsx", xlOpenXMLWorkbook
            '.Close SaveChanges:=False
        End With
    End With
    
    'Application.ScreenUpdating = True ' before the message box
    'MsgBox "Table exported.", vbInformation

End Sub