Sub Rapport()
Dim BD As Worksheet, R As Worksheet, M As Worksheet, lig&, f$, i&
Set BD = Sheets("BD")
Set R = Sheets("Rapport")
Set M = Sheets("Modele")
lig = 9 '1ère ligne de destination
Application.ScreenUpdating = False
R.Rows(lig).Resize(R.Rows.Count - lig + 1).Delete 'RAZ
With BD.[A1].CurrentRegion
f = .Cells(2, 1).NumberFormat 'mémorise
.Columns(1).NumberFormat = "General" 'format Standard
.AutoFilter 1, CDbl(Date - 1) 'filtre automatique
For i = 2 To .Rows.Count
If Not .Rows(i).Hidden Then
M.Range("C3") = .Cells(i, 2)
M.Range("E3") = .Cells(i, 4)
M.Range("G3") = .Cells(i, 3)
M.Range("I3") = .Cells(i, 7)
M.Range("D5") = .Cells(i, 5)
M.Rows("1:6").Copy R.Cells(lig, 1) 'copier-coller
lig = lig + 7
End If
Next
.AutoFilter
.Columns(1).NumberFormat = f
End With
R.[C7] = "Situation journalière du " & Format(Date - 1, "dd/mm/yyyy")
With R.UsedRange: End With 'actualise la barre de défilement verticale
R.Activate 'facultatif
End Sub