Macro copie sous condition et sur plusieur feuille

[creolia]

Bonjour à tous et déja désolé de ne pas joindre un fichier joint car la machine qui me sert à programmer à internet en panne.

je viens donc vers vous pour une petite modification de ma macro je cherche une solution qui me permettras de copier des lignes sur plusieur feuille sous condition.

la condition serais la suivante
condition1 si en colonne E la date est supérieur à 01/01/2009 et que en F la date est supérieur à 01/01/2012

les collone de B à J s'incremente dans la feuille recape.

pour faire simple je cherche que ses 2 conditions soit réunie pour que les copie de ses lignes se fasse.

exemple de la macro que j'utilise depuis un bout de temps mais qui est pas adapter à 2 condition

pouvez vous m'aid

Sub Filtre_vert2()

    Dim ws As Worksheet, Tbl() As Variant, C As Integer

   ' Application.ScreenUpdating = False
    
ReDim Tbl(1 To 9, 1 To 1)
C = 1
    For Each ws In Worksheets
        If Left(ws.Name, 9) = "FORMATION" Then
            With ws
                For Each cel In .Range("J5:J" & .Range("J65000").End(xlUp).Row)
                    If cel > 720 And cel < 2000 Then
                    
                    ' If s.Cells(i, "J") <= 0 And s.Cells(i, "J") <> "" And s.Cells(i, col) = UserForm1.ComboBox1 Then
                    
                        L = cel.Row
                        
                        Tbl(1, C) = .Range("B" & L).Value
                        Tbl(2, C) = .Range("C" & L).Value
                        Tbl(3, C) = .Range("D" & L).Value
                        Tbl(4, C) = .Range("K" & L).Value
                        Tbl(5, C) = Format(.Range("E" & L).Value, "mm/dd/yyyy")
                        Tbl(6, C) = Format(.Range("F" & L).Value, "mm/dd/yyyy")
                        Tbl(7, C) = Format(.Range("G" & L).Value, "mm/dd/yyyy")
                        Tbl(8, C) = .Range("H" & L).Value
                        Tbl(9, C) = .Range("J" & L).Value
                        C = C + 1
                      
                        ReDim Preserve Tbl(1 To 9, 1 To C)
                    End If
                Next cel
            End With


        End If
    Next ws
    
    Tbl = Application.Transpose(Tbl)
    
        With Sheets("recape")
        Li = .Range("A2000").End(xlUp).Row + 1
            .Cells(Li, 1).Resize(UBound(Tbl, 1), UBound(Tbl, 2)) = Tbl
    End With

 

[creolia]

Re : Macro copie sous condition et sur plusieur feuille

re si besoin posé moi vos question

 

[creolia]

Re : Macro copie sous condition et sur plusieur feuille

re bonjour à tous peut ont me dire si ma demande est dans le domaine du possible svp merci