Sub test()
Dim curCell As Range, newWbk As Workbook, dossierSauvegarde As String
dossierSauvegarde = "E:\aMiki\XLS\test\"
With ThisWorkbook.Sheets("Sans sous-total")
.Range(.Cells(3, 1), .Cells(3, 1).End(xlToRight).End(xlDown)).Sort key1:=.Cells(3, 1), order1:=xlAscending
Set curCell = .Cells(3, 1)
While curCell.Value <> vbNullString
If curCell.Value <> curCell.Offset(-1, 0).Value Then
Set newWbk = Application.Workbooks.Add
newWbk.SaveAs Filename:=dossierSauvegarde & "HELP_" & curCell.Value & ".xls", FileFormat:=56
.Range("A1").EntireRow.Copy newWbk.Sheets(1).Range("A1")
.Range("A2").EntireRow.Copy newWbk.Sheets(1).Range("A2")
End If
curCell.EntireRow.Copy newWbk.Sheets(1).Range("A1").End(xlDown).Offset(1, 0)
If curCell.Value <> curCell.Offset(1, 0).Value Then newWbk.Close True
Set curCell = curCell.Offset(1, 0)
Wend
End With
End Sub