Excel - programar macro para que reccorra las celdas de

Sub Distribución()

'------------------

'by Cacho Rodríguez

'------------------

Dim C As Range, D As Range

Application.ScreenUpdating = False

With ActiveSheet

  .[a1].CurrentRegion.Columns(1).AdvancedFilter 2, , .[aa1], True

  .[z1] = .[a1].Value

  On Error GoTo new_WS

  For Each C In .Range(.[aa2], .[aa1].End(xlDown))

    Set D = Sheets(CStr(C)).Cells(Rows.Count, "a").End(xlUp).Offset(1)

    .[z2] = C.Value

    .[a1].CurrentRegion.AdvancedFilter 2, .[z1:z2], D, False

    If D.Row > 1 Then D.Resize(, 3).Delete xlShiftUp

  Next

  On Error GoTo 0

  .Select

  .[z1].CurrentRegion.Clear

End With

Application.ScreenUpdating = True

MsgBox "Proceso terminado."

Exit Sub

new_WS:

With Sheets.Add(after:=Sheets(Sheets.Count))

  .Name = C

  Set D = Sheets(CStr(C)).[a1]

  Resume Next

End With

End Sub