Sub Balaye()

    Dim NoDupes As New Collection

    Application.ScreenUpdating = False

    A = Range([A2], [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("Données").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