Sub TEST()
Application.ScreenUpdating = False
xFichier = Empty
xCpt = 0
xFichierActuel = ActiveWorkbook.Name
xChemin = "C:\Users\toto\Documents\" 'Chemin d'enregistrement à adapter
Columns("A:B").Select
xDerlig = Range("A65000").End(xlUp).Row
ActiveSheet.Range("$A$1:$B$" & xDerlig).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
xDerlig = Range("B65000").End(xlUp).Row
For Each xCell In Range("B2:B" & xDerlig)
xNewFichier = xCell.Value
xOnglet = xCell.Offset(0, -1).Value
If xNewFichier <> xFichier Then
If ActiveWorkbook.Name <> xFichierActuel Then
Application.DisplayAlerts = False
ActiveWindow.Close (True)
Application.DisplayAlerts = True
End If
Workbooks.Add
xCpt = xCpt + 1
ActiveSheet.Name = xOnglet
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=xChemin & xNewFichier & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = True
xFichier = xNewFichier
Else
ActiveWorkbook.Sheets.Add
ActiveSheet.Name = xOnglet
End If
Next xCell
Application.DisplayAlerts = False
ActiveWindow.Close (True)
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Range("A1").Select
xMess = Empty
xMess = xMess & "Traitement terminé" & Chr(13)
xMess = xMess & xCpt & " fichier(s) ont été créés"
MsgBox xMess, vbInformation, "TRAITEMENT"
End Sub