exporter des données de plusieurs feuilles d'un classeur avec plusieurs conditions

Option Explicit
Sub Ventilation()
     Dim Sh As Worksheet
    Dim Cel As Range
    Dim DerLig As Long
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    For Each Sh In Sheets
        If Sh.Name <> "Data" And Sh.Name <> "Modèle" Then
            Sh.Delete
        End If
    Next Sh
    Sheets("Modèle").Visible = True
    With Sheets("Data")
        Columns("A:T").Select
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("E2:E10000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SetRange Range("A1:T10000")
        .Sort.Header = xlYes
        .Sort.MatchCase = False
        .Sort.Orientation = xlTopToBottom
        .Sort.SortMethod = xlPinYin
        .Sort.Apply
        Range("A1").Select
        DerLig = .[A65000].End(xlUp).Row
        .Range("A1:T" & DerLig).Name = "Base"
        .[Z1] = .[E1]
        .Range("E1:A" & DerLig).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("Z1"), Unique:=True
        For Each Cel In .Range("Z2:Z" & .[Z65000].End(xlUp).Row)
            If Cel.Value <> "" Then
                .[Z2] = Cel.Value
                Sheets("Modèle").Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = Cel.Value
                .Range("Base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("Z1:Z2"), _
                                              CopyToRange:=Range("A1:T1"), Unique:=False
                ActiveSheet.Cells.EntireColumn.AutoFit
            End If
            Cells(1, 1).Select
        Next Cel
        .Columns(26).Clear
        .Select
    End With
    Sheets("Data").[A1].Select
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    Sheets("Modèle").Visible = False
End Sub