Option Explicit
Sub Ventile()
Dim CurCell As Range, Titre As Range
Application.ScreenUpdating = 0
Columns("A:ES").Sort Key1:=Range("E2"), Order1:=xlAscending, Key2:=Range("A2"), Order2:=xlAscending, Header:=xlGuess
Range("A1").Select
Set CurCell = ThisWorkbook.Sheets("Feuil1").Range("E1")
Set Titre = ThisWorkbook.Sheets("Feuil1").Range("A1:EJ1")
While CurCell.Value <> vbNullString
With GetSheet(CurCell.Value)
Titre.EntireRow.Copy .Cells(1, 1)
CurCell.EntireRow.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
Set CurCell = CurCell.Offset(1, 0)
Columns("A:ES").Columns.AutoFit
Wend
Application.DisplayAlerts = 0
Sheets("State").Delete
Application.DisplayAlerts = 1
Sheets("Feuil1").Activate
End Sub
Public Function GetSheet(SheetName As String) As Worksheet
'Cette fonction renvoie la feuille nommée <SheetName> et la crée si elle n'existe pas
Dim CurSheet As Worksheet, Exist As Boolean
Exist = False
For Each CurSheet In ThisWorkbook.Sheets
If CurSheet.Name = SheetName Then Exist = True
Next CurSheet
If Not Exist Then
ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = SheetName
End If
Set GetSheet = ThisWorkbook.Worksheets(SheetName)
End Function