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
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
Code:
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
