Scinder un fichier en plusieurs onglets selon un critère d'une colonne

Sub separeOuiNon()

nb = Range("A" & Range("A:A").Count).End(xlUp).Row

For i = 2 To nb
    If UCase(Range("D" & i)) = "OUI" Then
        Rows(i).EntireRow.Copy Destination:=Sheets("OUI").Range("A" & Range("A:A").Count).End(xlUp).Offset(1, 0)
    Else
    Rows(i).EntireRow.Copy Destination:=Sheets("NON").Range("A" & Range("A:A").Count).End(xlUp).Offset(1, 0)
    End If
Next i
End Sub

Range("A1").CurrentRegion.Copy Destination:=Sheets(Nomfiltre)

Sub SplitData()
'EDITION version modifiée pour copier la ligne d'entête
'code initial d'Alex P. ->-> stackoverflow
   Dim DataMarkers(), Names As Range, name As Range, n As Long, i As Long

    Set Names = Range(Cells(2, "I"), Cells(Rows.Count, "I").End(xlUp))
    n = 0
    DeleteWorksheets

    For Each name In Names
        If name.Offset(1, 0) <> name Then
            ReDim Preserve DataMarkers(n)
            DataMarkers(n) = name.Row
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).name = name
            n = n + 1
        End If
    Next name
'
   For i = 0 To UBound(DataMarkers)
        If i = 0 Then
        Worksheets(1).Range("A1:I1").Copy Destination:=Worksheets(i + 2).Range("A1")
        Worksheets(1).Range("A2:I" & DataMarkers(i)).Copy Destination:=Worksheets(i + 2).Range("A2")
        Else
        Worksheets(1).Range("A1:I1").Copy Destination:=Worksheets(i + 2).Range("A1")
        Worksheets(1).Range("A" & (DataMarkers(i - 1) + 1) & ":R" & DataMarkers(i)).Copy Destination:=Worksheets(i + 2).Range("A2")
        End If
    Next i
End Sub

Sub DeleteWorksheets()
    Dim ws As Worksheet, activeShtIndex As Long, i As Long
    activeShtIndex = ActiveSheet.Index
    Application.DisplayAlerts = False
    For i = ThisWorkbook.Worksheets.Count To 1 Step -1
        If i <> activeShtIndex Then
            Worksheets(i).Delete
        End If
    Next i
    Application.DisplayAlerts = True
End Sub