1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
| Sub Test_Filter()
Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
Dim Clgn As Long
Dim Rng As Range, Rng_Insp As Range
Application.ScreenUpdating = False
Set WS1 = Worksheets("Base")
Set WS2 = Worksheets("Semaine")
Set WS3 = Worksheets("Insp")
Application.EnableEvents = False
date_debut = Date - Application.Choose(Application.Weekday(Date, 1), 4, 5, 6, 0, 1, 2, 3)
date_fin = date_debut + 6
With WS1
If .AutoFilterMode = False Then .Range("A7:F7").AutoFilter
.Range("A7:F7").AutoFilter Field:=3, Criteria1:=">=" & Format(date_debut, "0") _
, Operator:=xlAnd, Criteria2:="<=" & Format(date_fin, "0")
Set Rng = .[_filterdatabase].Resize(, 6).SpecialCells(xlCellTypeVisible)
Clgn = .[_filterdatabase].Resize(, 1).SpecialCells(xlCellTypeVisible).Count - 1
MsgBox "Clgn = " & Clgn
End With
If Clgn > 0 Then
Rng.Copy
'-- Extration des données dans la feuille "Semaine"
With WS2
.Range(.[A10], .[G10].End(xlDown)).Delete shift:=xlUp
.Range("A10").insert shift:=xlDown ', CopyOrigin:=xlFormatFromLeftOrAbove
.[E8].Value = "Semaine du " & date_debut & " au " & date_fin
End With
'-- Extration des données dans la feuille "Insp"
With WS3
Rng_Insp = Union(Rng.Column(1), Rng.Column(5), Rng.Column(3), Rng.Column(6))
Rng_Insp.Copy
.Range(.[A2], .[D2].End(xlDown)).Delete shift:=xlUp
.Range("A2").insert shift:=xlDown
End With
On Error Resume Next
WS1.ShowAllData
On Error GoTo 0
End If
Set WS1 = Nothing: Set WS2 = Nothing
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub |
Partager