Re
@Avisdebi,
Une version V2 beaucoup plus rapide.
ah non! J'ai bousiller la macro! a l'aide! La ligne
If t(i, 1) <> t(n, 1) Then n = n + 1: t(n, 1) = t(i, 1)
Voici la macro:
Dim sh As Worksheet, source As Range, t, i&, n&, idx&, ti
ti = Timer: Application.ScreenUpdating = False
Worksheets("Détail_Hre_FT").Copy before:=Worksheets(1)
With ActiveSheet
If .AutoFilterMode Then .Cells.AutoFilter
Set source = .Range("a1").CurrentRegion
source.Sort key1:=.Range("d1"), order1:=xlAscending, Header:=xlYes
source.AutoFilter: t = source.Columns(4)
n = 2
For i = 3 To UBound(t)
If t(i, 1) <> t(n, 1) Then n = n + 1: t(n, 1) = t(i, 1)
Next i
On Error Resume Next
For i = 2 To n
source.AutoFilter Field:=4, Criteria1:=t(i, 1)
idx = 0: idx = Sheets(t(i, 1)).Index
If idx = 0 Then With Worksheets.Add(after:=Worksheets(Worksheets.Count)): .Name = t(i, 1): End With
With Sheets(t(i, 1))
.UsedRange.Clear
source.SpecialCells(xlCellTypeVisible).Copy .Range("a1")
End With
Next i
.ShowAllData: .Activate
Application.DisplayAlerts = False: .Delete
MsgBox "Terminé en " & Format(Timer - ti, "0.00\sec.")
End With
End Sub