Sub Filtre_Export()
Dim Rg As Range, Rg1 As Range, E As Range
Dim Sh As Worksheet, Sh1 As Worksheet
Application.ScreenUpdating = False
With Worksheets("Validité VMP") 'Nom Feuille à adapter
Set Rg = .Range("D10
" & .Range("D65536").End(xlUp).Row)
End With
Set Sh = Worksheets.Add
On Error Resume Next
With Rg
.AdvancedFilter xlFilterCopy, , Sh.Range("A10"), True
Worksheets(.Parent.Name).ShowAllData
End With
With Sh
Set Rg1 = .Range("A11:A" & .Range("A65536").End(xlUp).Row)
End With
For Each c In Rg1
Set Sh1 = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh1.Name = c.Value
With Rg
.AutoFilter Field:=1, Criteria1:=c.Value
.SpecialCells(xlCellTypeVisible) _
.EntireRow.Copy Sh1.Range("A10")
End With
Next
Rg.AutoFilter
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
End Sub