Autres filtrer les données avec deux critères en vba

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Solution
Bonjour le Fil ;
avec un truc comme ça
VB:
Sub copy_filtre()
Application.ScreenUpdating = False
Dim sh1, sh2
Dim LastRw&
Set Sh = Sheets("Synt")

Sheets("Synt").Select
Range("A2:I" & Rows.Count).ClearContents
LastRw = Sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
crit = Sh.Range("L2")
crit2 = Sh.Range("M2")  'Ajout Ici
For i = 1 To 2
With Sheets("Ra" & i).Range("A1")
    If Not Sheets("Ra" & i).FilterMode Then
      .AutoFilter
    End If
   
    .AutoFilter Field:=1, Criteria1:="=" & crit
    .AutoFilter Field:=3, Criteria1:="=" & crit2 'Ajout Ici
 
    .Range("_FilterDatabase").Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
     Sh.Range("A" & LastRw).PasteSpecial xlPasteValues
     LastRw = Sh.Cells(Rows.Count, 1).End(xlUp).Row + 1...
Bonjour le Fil ;
avec un truc comme ça
VB:
Sub copy_filtre()
Application.ScreenUpdating = False
Dim sh1, sh2
Dim LastRw&
Set Sh = Sheets("Synt")

Sheets("Synt").Select
Range("A2:I" & Rows.Count).ClearContents
LastRw = Sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
crit = Sh.Range("L2")
crit2 = Sh.Range("M2")  'Ajout Ici
For i = 1 To 2
With Sheets("Ra" & i).Range("A1")
    If Not Sheets("Ra" & i).FilterMode Then
      .AutoFilter
    End If
   
    .AutoFilter Field:=1, Criteria1:="=" & crit
    .AutoFilter Field:=3, Criteria1:="=" & crit2 'Ajout Ici
 
    .Range("_FilterDatabase").Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
     Sh.Range("A" & LastRw).PasteSpecial xlPasteValues
     LastRw = Sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
    .AutoFilter
End With
Next
    Range("A1").Select
End Sub
Jean marie
 
Dernière édition:
Bonjour le Fil ;
avec un truc comme ça
VB:
Sub copy_filtre()
Application.ScreenUpdating = False
Dim sh1, sh2
Dim LastRw&
Set Sh = Sheets("Synt")

Sheets("Synt").Select
Range("A2:I" & Rows.Count).ClearContents
LastRw = Sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
crit = Sh.Range("L2")
crit2 = Sh.Range("M2")  'Ajout Ici
For i = 1 To 2
With Sheets("Ra" & i).Range("A1")
    If Not Sheets("Ra" & i).FilterMode Then
      .AutoFilter
    End If
  
    .AutoFilter Field:=1, Criteria1:="=" & crit
    .AutoFilter Field:=3, Criteria1:="=" & crit2 'Ajout Ici
 
    .Range("_FilterDatabase").Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
     Sh.Range("A" & LastRw).PasteSpecial xlPasteValues
     LastRw = Sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
    .AutoFilter
End With
Next
    Range("A1").Select
End Sub
Jean marie
Merci beaucoup !
Ca fonctionne
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
40
Affichages
3 K
  • Question Question
Autres Code VBA
Réponses
11
Affichages
266
Retour