Mensualites

Sub mensualiser()
Dim date_jour As Date
Dim nbre As Long, valide As Long, lig As Long, lig_srce As Long, cptr As Long


date_jour = Range("journee")
nbre = Application.CountIf(Range("date_op"), date_jour)
valide = Application.CountIf(Range("A4:A2000"), date_jour)
If nbre = 0 Or valide > 0 Then: Exit Sub


lig = Range("A2000").End(xlUp).Row + 1
With Sheets("recap")
lig_srce = .Columns(1).Find(date_jour, .Range("A4"), , , xlByRows).Row

cptr = 1
While cptr <= nbre
tablo = .Range(.Cells(lig_srce, 1), .Cells(lig_srce, 4))
ActiveSheet.Range(Cells(lig, 1), Cells(lig, 4)) = tablo
lig = lig + 1
lig_srce = lig_srce + 1
cptr = cptr + 1
Wend

End With

End Sub

Cliquez pour agrandir...