Sub Recherche(Optional ouvre As Boolean = False)
Dim F As Worksheet, w As Worksheet, n&
Set F = Sheets("Synthèse")
Application.ScreenUpdating = False
On Error Resume Next 'à cause de .ShowAllData
F.ShowAllData 'au cas où...
F.range("A2:H" & F.Rows.Count).Delete xlUp 'RAZ
For Each w In Worksheets
If w.Name <> F.Name Then
w.ShowAllData 'au cas où...
With Intersect(w.[A:IU], w.UsedRange.EntireRow)
.Columns("IU") = .Columns(8).Value 'mémorise en colonne IU
.Columns(8) = "=""" & w.Name & "!F""&" & "ROW()"
.Columns(8) = .Columns(8).Value 'supprime les formules
.Cells(2, "IV") = "=AND(YEAR(F2)=YEAR(TODAY()),MONTH(F2)=MONTH(TODAY()),IU2="""")"
.AdvancedFilter xlFilterInPlace, .Cells(1, "IV").Resize(2) 'filtre avancé
.Offset(1).Resize(, 8).Copy F.range("A" & F.Rows.Count).End(xlUp)(2)
.AdvancedFilter xlFilterInPlace, ""
.Cells(2, "IV") = ""
.Columns(8) = .Columns("IU").Value 'restitue en colonne H
.Columns("IU") = ""
End With
End If
Next
F.Columns(8).HorizontalAlignment = xlGeneral
F.Columns(8).AutoFit
If ouvre Then
With Application
.EnableEvents = False: F.Activate: .EnableEvents = True: .ScreenUpdating = True
End With
n = F.range("A" & F.Rows.Count).End(xlUp).Row - 1
MsgBox "Vous avez " & n & " contrôles obligatoires à effectuer ce mois-ci !"
End If
End Sub