Copier coller page de cellule vers nouvelle feuille

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