Option Explicit
Sub ListageDonnées()
Application.ScreenUpdating = 0
Dim DerL%, i As Byte, X&
With Sheets("Récap")
DerL = .Range("B65536").End(xlUp).Row
If DerL > 11 Then .Range("B11:B" & DerL).ClearContents
For i = 1 To Sheets.Count
If Sheets(i).Name <> "Récap" Then
DerL = Sheets(i).Range("A65536").End(xlUp).Row
Sheets(i).Range("A1:A" & DerL).Copy .Range("B" & .Range("B65536").End(xlUp).Row + 1)
End If
Next i
End With
Range("B11:B25").Sort Key1:=Range("B11"), Order1:=xlAscending, Header:=xlGuess
DerL = Feuil1.[B65536].End(xlUp).Row
For X = DerL To 11 Step -1
If Evaluate("COUNTIF(B11:B" & DerL & ",""" & Cells(X, 2).Value & """)") > 1 Then Cells(X, 2).Delete
Next X
End Sub