Filtre sur VBA : Filtrer même si la valeur n'est pas présente

Bonjour à tous,

Je vous explique le problème, j'ai une macro qui doit extraire des données sur plein de fichiers (qui sont toujours les même) dans un dossier et parfois les filtres différent, je m'explique, le filtre Accepté sera présent quoi qu'il arrive mais le filtre Payé ou Prévu peuvent ne pas être présents, je voudrai que ma macro fonctionne même si ces filtres ne sont pas présent sur le fichier source.

Toute aide serait le bienvenue, Bien à vous :

Sub ExtractionTPE()

'Optimisation des erreurs
Application.DisplayAlerts = False
Application.ScreenUpdating = False

'Déclaration des variables
Dim wb As Workbook, wbs As Workbook
Dim ws As Worksheet, wss As Worksheet
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'Optimisation de la vitesse de traitement
  Application.ScreenUpdating = False
  Application.EnableEvents = False

'Déclarer valeur aux variables
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Feuil1")
R1 = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

'Activation de l'explorateur de fichier windows
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'En cas d'erreur
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Prendre tout les fichiers qui ont l'extension .xls
  myExtension = "*.xls*"

'Cibler chemin qu'on a donné + extension
  myFile = Dir(myPath & myExtension)
cnt = 0
'Activation de la boucle avec tout les fichiers du dossier
  Do While myFile <> ""
      Set wbs = Workbooks.Open(Filename:=myPath & myFile)
      Set wssR = wbs.Sheets(1) 'comme il y a un seul onglet dans le classeur
 'Action à effectuer (copier/filtrer/coller)
      DoEvents
            Rs = wssR.Cells(Rows.Count, 1).End(xlUp).Row
            R1 = ws.Cells(Rows.Count, 2).End(xlUp).Row + 1
            Set Rng = wssR.Range("A2:Z" & Rs)
            wssR.Range("A1").AutoFilter Field:=5, Criteria1:="=Accepté" _
        , Operator:=xlOr, Criteria2:="=Prévu"
            Range("R2").Select
            Range(Selection, Selection.End(xlDown)).Select
            Range(Selection, Selection.End(xlToLeft)).Select
            Selection.Copy
            ws.Range("A" & R1).PasteSpecial

    Application.CutCopyMode = False

    'Fermer le fichier source sans sauvegarder
      wbs.Close SaveChanges:=False

    'Être sur que le fichier soit bien fermé
      DoEvents

    'Prochain fichier
      myFile = Dir
  Loop

'Message de fin de tâche
  MsgBox "Fin de la tâche"

ResetSettings:
  'Reactivation des paramêtre de macro
    Application.EnableEvents = True

    Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
Rechercher des sujets similaires à "filtre vba filtrer meme valeur pas presente"