Run-time Error '91' lors de l'utilisation d'un filtre

pasquiba

XLDnaute Nouveau
Bonjour à tous,

Je voudrais filtrer les données d'une feuille que j'ai préalablement importée d'un autre fichier excel (grâce à la fonction CopyPastePOStatus_EYServices).

La fonction fonctionne et importe effectivement la feuille dans mon classeur. Le problème c'est que le filtre déclenche une erreure '91'.
Ce qui est le plus louche, c'est que le programme principale Sub BSK_STEP2() fonctionne très bien seul. J'ai juste voulu ajouter l'utilisation d'un bouton et d'une fonction pour éviter le copier coller manuel des feuilles.

Cela fait deux jours que j'écume les forum sans trouver de solutions: c'est pourquoi je fais appel çà vous!


LA FONCTION

'Fonction qui demande la localisation du fichier "PO status - EY SERVICES" afin de le copier dans l'onglet PO status - EY SERVICES

Function CopyPastePOStatus_EYServices()

'FEUILLE"PO STATUS - EY SERVICES" DEJA PRESENTE?
MsgBox Not IsError(Evaluate("=" & "PoStatusEYServices" & "!A1"))
If Not IsError(Evaluate("=" & "PoStatusEYServices" & "!A1")) Then ThisWorkbook.Sheets("PoStatusEYServices").Delete
End If

'DEMANDE A L'UTILISATEUR DU CHEMIN POUR ALLER AU FICHIER SOUHAITE
Dim chemin As String
MsgBox "Fichier PO status - EY SERVICES"
chemin = Application.GetOpenFilename
CopyPastePOStatus_EYServices = chemin
MsgBox chemin

'COPIE/COLLE DE LA FEUILLE
Workbooks.Open chemin
Sheets(1).Select
ActiveSheet.Copy After:=ThisWorkbook.ActiveSheet
ActiveSheet.Name = "PoStatusEYServices"

'FERMETURE DU FICHIER PO status - EY SERVICES
Dim TabSplit() As String
TabSplit = Split(chemin, "\")
'MsgBox TabSplit(UBound(TabSplit))
Workbooks(TabSplit(UBound(TabSplit))).Close savechanges:=False


'DEPLACEMENT DE LA FEUILLE
ThisWorkbook.Activate
Sheets("PoStatusEYServices").Move After:=Sheets("ALL MISSING")

End Function




LE PROGRAMME PRINCIPAL

Sub BSK_STEP2()

'APPEL DE LA FONCTION
Application.DisplayAlerts = False
Dim chemin As String
chemin = CopyPastePOStatus_EYServices()

'UNE SERIE DE CALCULS QUI FONCTIONNENT SUR LA PAGE CHECK
Sheets("CHECK").Select
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

Sheets("ALL MISSING").Select
Range("A1:G1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("CHECK").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("ALL MISSING").Select
Columns("O:O").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CHECK").Select
Columns("H:H").Select
ActiveSheet.Paste

Sheets("ALL MISSING").Select
Columns("H:H").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CHECK").Select
Columns("J:J").Select
ActiveSheet.Paste

Range("A1").Select

Sheets("PoStatusEYServices").Select
Sheets("PoStatusEYServices").Activate

'C'EST ICI QUE L'ERREUR SE DECLENCHE, LORS DU TRAVAILLE SUR LA FEUILLE POStatusEYServices
ActiveWorkbook.Worksheets("PoStatusEYServices").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("PoStatusEYServices").AutoFilter.Sort.SortFields.Add Key:=Range("A1:A100000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("PoStatusEYServices").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Sheets("CHECK").Select
Columns("D:D").Select
Selection.Copy
Columns("I:I").Select
ActiveSheet.Paste
Range("I2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(ISNA(VLOOKUP(VLOOKUP(RC[-5],'PoStatusEYServices'!R2C[-8]:R100000C,8,FALSE),MAPPING!R2C[-8]:R10C[-7],2,FALSE)=RC[-2]),""NOT FOUND IN THE CRM"",VLOOKUP(VLOOKUP(RC[-5],'PoStatusEYServices'!R2C[-8]:R100000C,8,FALSE),MAPPING!R2C[-8]:R10C[-7],2,FALSE)=RC[-2])"
Range("I2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Range("I2").Select

Sheets("CHECK").Select
Range("I1").Select
ActiveCell.FormulaR1C1 = "CHECK"
Range("I2").Select

End Sub
 

Discussions similaires

Réponses
3
Affichages
569
Réponses
4
Affichages
586
Réponses
2
Affichages
926

Statistiques des forums

Discussions
312 145
Messages
2 085 762
Membres
102 966
dernier inscrit
InitialPP