Option Explicit
Sub Ventilation()
Dim X%
Application.ScreenUpdating = 0
For X = 3 To Feuil1.Range("D" & Rows.Count).End(xlUp).Row
Feuil1.Activate
Feuil1.Range("B" & X & ":K" & X).Copy
Sheets(Format(Range("D" & X), "mmmm")).Activate
Range("A" & Range("B" & Rows.Count).End(xlUp).Row + 1).Select
ActiveSheet.Paste
ActiveSheet.Range("$A$1:$J$1000").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), Header:=xlYes
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("B3:B1000"), SortOn:=xlSortOnValues
.SetRange Range("A2:J1000")
.Header = xlYes
.Apply
End With
Cells.Columns.AutoFit
Range("A1").Select
Next X
Feuil1.Activate
Application.CutCopyMode = 0
End Sub