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...
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
Merci beaucoup !Bonjour le Fil ;
avec un truc comme ça
Jean marieVB: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