Sub ventiler()
Dim i&, j&, nom$, ind&
Application.ScreenUpdating = False
With Worksheets("LISTING")
For i = 4 To .Rows.Count Step 180
For j = 4 To 8 Step 4
nom = .Cells(i + 1, j)
If Trim(nom) = "" Then Exit For
On Error Resume Next
ind = 0: ind = Worksheets(nom).index
On Error GoTo 0
If ind = 0 Then
ThisWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = nom
ind = Worksheets(nom).index
End If
.Range("1:3").Copy Worksheets(ind).Range("1:3")
.Range("a4:c179").Copy Worksheets(ind).Range("a4")
.Range("d4:f179").Offset(i - 4, j - 4).Copy Worksheets(ind).Range("d4")
.Range("a:j").Copy
Worksheets(ind).Range("a:f").Columns.AutoFit
Next j
Next i
End With
Application.CutCopyMode = False
End Sub