Copier resultat de 2 filtres elabores a la suite

Bonjour,

Je dispose de 2 feuilles ayant les mêmes caractéristiques.

Même nombre de colonnes, même intitulés.

La source de données étant différente je dois conserver ces 2 feuilles distinctes.

Je souhaite effectuer un filtre élaboré pour chacune de ces feuilles et copier chaque résultat dans une feuille unique.

'On effectue le filtre N°1 que l'on recopie dans la feuille résultat
Sheets("PR1").Range("A1:AC" & DERL1).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("PR1").Range("AP1:AQ4"), CopyToRange:=Sheets("Résultat").Range( _
        "A1:C1"), Unique:=False

'On effectue le filtre N°2 que l'on recopie dans la feuille résultat
Sheets("Pza").Range("A1:AC" & DERL2).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Pza").Range("AP1:AQ2"), CopyToRange:=Sheets("Résultat").Range( _
        "A1:C1"), Unique:=False

Il conviendrait de lancer le filtre de la feuille 1, puis celui de la feuille 2.

Cependant, il faudrait que le résultat du filtre N°2 se mette à la suite du filtre N°1 dans la feuille "Résultat".

Je crois qu'il convient d'écrire différemment dans le filtre N°2:

CopyToRange:=Sheets("Résultat").Range(  "A1:C1"),

En effet, le Range("A1:C1") dans ce filtre supprime le résultat du filtre N°1.

De plus, on ne connait pas le nombre de ligne après le filtre N°1

Auriez vous une idée ?

Cordialement

Bonjour

Sans fichier

A tester

Sub Filtre()
Dim DERL1 As Long
Dim DERL2 As Long
Dim Ligne As Long

  DERL1 = Sheets("PR1").Range("A" & Rows.Count).End(xlUp).Row
  DERL2 = Sheets("PR2").Range("A" & Rows.Count).End(xlUp).Row

  With Sheets("Résultat")
    'On effectue le filtre N°1 que l'on recopie dans la feuille résultat
    Sheets("PR1").Range("A1:AC" & DERL1).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("PR1").Range("AP1:AQ4"), CopyToRange:=.Range("A1:C1"), Unique:=False

    Ligne = .Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("A1:C1").Copy .Range("A" & Ligne)

    'On effectue le filtre N°2 que l'on recopie dans la feuille résultat
    Sheets("Pza").Range("A1:AC" & DERL2).AdvancedFilter Action:=xlFilterCopy, _
          CriteriaRange:=Sheets("Pza").Range("AP1:AQ2"), CopyToRange:=.Range("A" & Ligne & ":C" & Ligne), Unique:=False

    .Range("A" & Ligne & ":C" & Ligne).Delete shift:=xlShiftUp
  End With
End Sub

Bonjour,

Merci.

Cela fonctionne.

Désolé pour l'absence de fichier.

Cordialement