Problème filtre élaboré

 1) Tu vas dans https://www.cjoint.com/ 
 2) Tu cliques sur [Parcourir] pour sélectionner ton fichier (15 Mo maxi)
 3) Tu défiles vers le bas pour cliquer sur le bouton bleu [Créer le lien Cjoint] 
 4) Au bout de quelques secondes la deuxième page s'affiche, avec le lien en gras ; tu fais un clic-droit dessus et tu choisis "Copier le lien"
 5) Tu reviens dans ta discussion sur CCM, et dans ton message tu fais "Coller".
=>Voir la fiche https://www.commentcamarche.net/faq/29493-utiliser-cjoint-pour-heberger-des-fichiers 

Option Explicit
Dim chemin, liste_pni As String
  Dim Wbk  As Workbook
Dim i, j, der_lig As Integer
    Public der_col, nb_siret, k As Integer
    Dim MyArea As String
    Public liste_siret As Variant

Sub tdb()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
     
    Call base
    Call siret
   
    For k = 2 To 6 '1ere ligne correspond aux intitulés donc on commence à la 2è ligne
    
    Call filtre(k)
    Next
    
    Application.DisplayAlerts = False
    Sheets(Array("maquette", "export")).Delete
    Range("A1").Select
    
    Application.DisplayAlerts = True
    Application.Quit
End Sub





Sub base()
    
   Sheets("export").Select
      Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    der_col = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    Range(Selection, Selection.End(xlDown)).Select
    der_lig = Range("A" & Rows.Count).End(xlUp).Row
     MyArea = "=export!R1C1:R" & der_lig & "C" & der_col
    ActiveWorkbook.Names.Add Name:="base", RefersToR1C1:=MyArea
End Sub

' Liste siret

Sub siret()
    Dim base2 As Variant
    Sheets("export").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Name = "base2"
    
    'nettoyage de la zone
    Range("ZA1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Clear
    
    
    Range("A1:D50000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "ZA1"), Unique:=True
      
    nb_siret = Range("ZA2").End(xlDown).Row - 1
     
    
    'Tri par siret croissant
    Range("ZA2:ZD" & nb_siret + 1).Select
    Selection.Sort Key1:=Range("ZA2:ZD" & nb_siret + 1), Order1:=xlAscending
    Selection.Name = "liste_pni"
    
    ' liste siret
Range("ZA2:ZA" & nb_siret + 1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "ZZ1"), Unique:=True

   Range("ZZ2:ZZ" & nb_siret + 1).Name = "liste_siret"
   

End Sub

'remplissage de la maquette
Sub filtre(k As Integer)

    Application.ScreenUpdating = False
    Sheets("Maquette").Copy After:=Sheets("export")
    ActiveSheet.Name = "siret_" & Sheets("export").Range("ZA" & k) & Sheets("export").Range("ZC" & k)
    
    Dim feuille_siret As String
    feuille_siret = ActiveSheet.Name
    Range("base").Rows("1:1").Copy
    ActiveSheet.Select
    Range("AB2").Select
    ActiveSheet.Paste
    
    Range("Y1") = "DC_LBLETTDT"
    Range("Z1") = "Type"
    Range("AA1") = "SIRET"

    Range("AA2") = Sheets("export").Range("ZA" & k) 'DT
    Range("Y2") = Sheets("export").Range("ZB" & k) 'Type
    Range("Z2") = Sheets("export").Range("ZC" & k) 'siret
    
    Sheets(feuille_siret).Select
    Range("Y1:AA2").Select
    Dim crit, extr As Range
    Set crit = Sheets(feuille_siret).Range("Y1:AA2")
    Set extr = Sheets(feuille_siret).Range(Cells(2, 28), Cells(2, 28 + der_col - 1))
    'Application.CutCopyMode = False
    'zone de criteres
'    ActiveWorkbook.Names.Add Name:="crit", RefersTo:= _
'        "='" & Sheets(feuille_siret).Name & "'!R1C27:R2C27"
    ActiveWorkbook.Names.Add Name:="crit", RefersTo:=crit
    
    'zone d'extraction
    Range("AB2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    ActiveWorkbook.Names.Add Name:="extr", RefersTo:=extr

    'filtre
    Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("crit"), CopyToRange:=Range("extr"), Unique:=True
    
  
  
End Sub

    Range("A1:D50000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("ZA1"), Unique:=True

    Set crit = Sheets(feuille_siret).Range("Y1:AA2")

    Set crit = Sheets(feuille_siret).Range("Y1:AA1")

Range("AA2") = Sheets("export").Range("ZA" & k) 'DT
Range("Y2") = Sheets("export").Range("ZB" & k) 'Type
Range("Z2") = Sheets("export").Range("ZC" & k) 'siret