Sub Balaye()
Dim NoDupes As New Collection
Application.ScreenUpdating = False
A = Range([C2], [A65536].End(xlUp)).Value
On Error Resume Next
' Boucle pour récupérer la collection d'items uniques
For j = 1 To UBound(A, 1)
NoDupes.Add A(j, 1), CStr(A(j, 1))
Next j
' Réactivation du gestionnaire d'erreurs
On Error GoTo 0
Range("A1").CurrentRegion.Select
With Selection.CurrentRegion
Intersect(.Cells, .Offset(1)).Select
End With
B = Selection.Value
NbCol = Selection.Columns.Count
[A1].Select
ReDim Tableau(1 To UBound(B), 1 To NbCol)
For k = 1 To UBound(B, 1)
For Z = 1 To NbCol
Tableau(k, Z) = B(k, Z)
Next Z
Next k
H = 1
For i = 1 To NoDupes.Count
Sheets.Add after:=Sheets(i)
ActiveSheet.Name = NoDupes(i)
For x = 1 To UBound(A, 1)
If Tableau(x, 1) = NoDupes(i) Then
For w = 1 To NbCol
Cells(H + 1, w).Value = Tableau(x, w)
Next w
H = H + 1
Else
End If
Next x
H = 1
Next i
Sheets("DSN").Activate
NbSheet = ActiveWorkbook.Sheets.Count
Range([A1], [IV1].End(xlToLeft)).Select
Set MaPlage = Selection
[A1].Select
For NS = 2 To NbSheet
Set Destination = ActiveWorkbook.Sheets(NS).Range("A1")
MaPlage.Copy Destination
Next NS
End Sub