Légère modification code VBA

Bonjour à tous les membres de la communauté,

J'aimerai modifier mon code VBA ici présent:

Option Explicit

Public Sub cmdCreateWorksheets_Click()
Dim ws As Worksheet, ws2 As Worksheet, WSnew As Worksheet
Dim lo As ListObject, lo2 As ListObject
Dim Cell As Range
Dim lRow As Long

    With Application
        .DisplayAlerts = False
        '.EnableEvents = False
        .ScreenUpdating = False
    End With

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> ActiveSheet.Name Then ws.Delete
    Next ws

    Set ws = ActiveSheet
    Set lo = ws.ListObjects(1)

    If lo.ShowAutoFilter Then
        If lo.AutoFilter.FilterMode Then lo.AutoFilter.ShowAllData
    Else
        lo.ShowAutoFilter = True
    End If

    Set ws2 = ActiveWorkbook.Worksheets.Add
    With ws2
        lo.ListColumns(9).Range.AutoFilter field:=9, Criteria1:="<>"
        lo.ListColumns(8).DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
        .Cells(1).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        .Cells(1).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlNo
        lRow = .Cells(Rows.Count, 1).End(xlUp).Row
        For Each Cell In .Range("A1:A" & lRow)
            lo.Range.AutoFilter field:=8, Criteria1:="=" & Cell.Value
            Set WSnew = ActiveWorkbook.Worksheets.Add(after:=Worksheets(Worksheets.Count))
            WSnew.Name = Cell.Value
            lo.Range.SpecialCells(xlCellTypeVisible).Copy
            With WSnew
                With .Cells(1)
                    .PasteSpecial xlPasteColumnWidths
                    .PasteSpecial xlPasteValuesAndNumberFormats
                End With
                Application.CutCopyMode = False
                Set lo2 = .ListObjects.Add(xlSrcRange, WSnew.Cells(8).CurrentRegion, , xlYes)
                With lo2
                    .TableStyle = "TableStyleLight1"
                    .ShowTotals = True
                    .ListColumns(10).TotalsCalculation = xlTotalsCalculationSum
                End With
                .Activate
                .Cells(1).Select
                ActiveWindow.DisplayGridlines = False
            End With
        Next Cell
    End With

    lo.AutoFilter.ShowAllData
    ws2.Delete
    ws.Activate

    MsgBox "Terminé"

    With Application
        .DisplayAlerts = True
        '.EnableEvents = True
    End With

    Set lo = Nothing
    Set WSnew = Nothing: Set ws2 = Nothing: Set ws = Nothing

End Sub

J'aimerai donc le modifier afin que dans les onglets, seules les colonnes F G H I J K apparaissent (voir fichier joint pour davantage de clarté!)

Bonjour,

Voir fichier modifié.

Cdlt.

Encore merci pour un problème de plus que vous avez su résoudre avec brio !