Sub Demo()
Application.ScreenUpdating = False
With Feuil1
With .Cells(1).CurrentRegion.Columns
C& = .Count + 2
.Item(2).AdvancedFilter xlFilterCopy, , .Parent.Cells(C), True
End With
With .Cells(C).CurrentRegion
.Sort .Cells(1), xlAscending, Header:=xlYes
N& = .Rows.Count
End With
For R& = 2 To N
S$ = .Cells(R, C).Value: .Cells(2, C).Value = S
With Worksheets
If Evaluate("ISREF('" & S & "'!A1)") Then .Item(S).UsedRange.Clear _
Else .Add(, .Item(.Count)).Name = S
End With
.Cells(1).CurrentRegion.AdvancedFilter xlFilterCopy, .Cells(C).Resize(2), _
Worksheets(S).Cells(1)
With Worksheets(S).Cells(1).CurrentRegion
.Sort .Cells(1), xlAscending, Header:=xlYes
End With
Next
.Cells(C).Resize(N).Clear
End With
Application.ScreenUpdating = True
End Sub