Bonjour à Tous

Je cherche a appliquer un filtre élaboré sur plusieurs fichiers texte dans un même répertoire ayant toujours la même structure des données via ce code.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
 
Sub Ellipse1_QuandClic()
Dim Repertoire1 As String, Fichier As String, Repertoire2 As String, zone As String, zonec As String
Dim fresultat As String, nomfich As String, nomfeuile As String, fichierc As String
Dim Wb As Workbook
Dim Wc As Workbook
Dim Ws As Worksheet
Dim Wv As Worksheet
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
'Zone de Critéres
 
    fichierc = "C:\Stock\Oasis\critéres.xls"
    Set Wc = Workbooks.Open(fichierc)
    Windows("critéres.xls").Activate
    Sheets(1).Select
    b = Sheets(1).Range("C65536").End(xlUp).Row
    zonec = "A1:AJ" & b
 
 
 
    Repertoire1 = "C:\Stock\Oasis\Brute\"
    Repertoire2 = "C:\Stock\Oasis\Tr1\"
    i = 1
 
 
'Spécifie la recherche pour le fichiers .xls
 
 
Fichier = Dir(Repertoire1 & "*.xls")
 
 
 
'Boucle sur les fichiers du répertoire
 
Do While Fichier <> ""
 
            Fich = Repertoire1 & Fichier
            Set Wb = Workbooks.Open(Fich) 'ouverture du fichier
            Set Ws = Wb.Sheets(1)
 
 
 
                'Filtre
                Ws.Select
                b = Ws.Range("A65536").End(xlUp).Row
                zone = "A1:AJ" & b
 
                Range("A1").Select
                Range(zone).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
                Workbooks("critéres.xls").Sheets(1).Range(zonec), Unique:=False
                nomfich = Wb.Name
                nonfeuil = Ws.Name
                Ws.Select
                b = Ws.Range("A65536").End(xlUp).Row
                zone = "A1:AJ" & b
                Range(zone).Select
                Selection.Copy
                Workbooks.Add
                'ActiveWorkbook.Name = nomfich
                'Sheets(1).Name = nomfeuil
                ActiveSheet.Paste
                Application.CutCopyMode = False
                fresultat = Repertoire2 & nomfich
                ActiveSheet.Name = nonfeuil
                Wb.Close
 
                ActiveWorkbook.SaveAs Filename:=fresultat, FileFormat:=xlNormal, _
                Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
                CreateBackup:=False
                ActiveWorkbook.Close
 
                Fichier = Dir
 
 
Loop
 
End Sub
Ceci marche sauf deux cas:
1- le fichier ne contient que la ligne d'entête
2- le fichier étant texte ayant plus de 63536 lignes

Comment je peut corriger ce code?