Reducir código

Buenas estimados,

Es posible reducir el código de la siguiente macro?

Los slicers se pre-seleccionan dependiendo del usuario de la computadora donde sea abierto el reporte, el libro está bloqueado con ribbon y pestañas ocultas, el problema del código es que son varios usuarios con diferentes accesos por lo que se puede hacer extenso.

Muchas gracias por la ayuda.

Sub slicer()

'

' slicer Macro

'

Application.ScreenUpdating = False

Dim usuario As String

  usuario = Environ("username")

  If usuario = "perezq" Then

  MsgBox "Bienvenido " & usuario

Sheets("control").Select

With ActiveWorkbook.SlicerCaches("Slicer_País24")

  .SlicerItems("Costa Rica").Selected = True

  .SlicerItems("Honduras").Selected = False

  .SlicerItems("Nicaragua").Selected = False

  .SlicerItems("Rep. Dominicana").Selected = False

  End With

  With ActiveWorkbook.SlicerCaches("Slicer_Área")

  .SlicerItems("zona1").Selected = True

  .SlicerItems("zona2").Selected = False

  .SlicerItems("zona3").Selected = False

  .SlicerItems("zona4").Selected = False

  .SlicerItems("zona5").Selected = False

  .SlicerItems("zona6").Selected = False

  End With

  With ActiveWorkbook.SlicerCaches("Slicer_País5")

  .SlicerItems("Costa Rica").Selected = True

  .SlicerItems("Honduras").Selected = False

  .SlicerItems("Nicaragua").Selected = False

  .SlicerItems("Rep. Dominicana").Selected = False

  End With

  With ActiveWorkbook.SlicerCaches("Slicer_Área8")

  .SlicerItems("zona1").Selected = True

  .SlicerItems("zona2").Selected = False

  .SlicerItems("zona3").Selected = False

  .SlicerItems("zona4").Selected = False

  .SlicerItems("zona5").Selected = False

  .SlicerItems("zona6").Selected = False

  End With

  With ActiveWorkbook.SlicerCaches("Slicer_País7")

  .SlicerItems("Costa Rica").Selected = True

  .SlicerItems("Honduras").Selected = False

  .SlicerItems("Nicaragua").Selected = False

  .SlicerItems("República Dominicana").Selected = False

  End With

  With ActiveWorkbook.SlicerCaches("Slicer_Área41")

  .SlicerItems("zona1").Selected = True

  .SlicerItems("zona2").Selected = False

  .SlicerItems("zona3").Selected = False

  .SlicerItems("zona4").Selected = False

  .SlicerItems("zona5").Selected = False

  .SlicerItems("zona6").Selected = False

  .SlicerItems("Finance").Selected = False

  .SlicerItems("RH").Selected = False

  .SlicerItems("despacho").Selected = False

  .SlicerItems("Inventario").Selected = False

  .SlicerItems("Marketing").Selected = False

  End With

  With ActiveWorkbook.SlicerCaches("Slicer_País11")

  .SlicerItems("Costa Rica").Selected = True

  .SlicerItems("Honduras").Selected = False

  .SlicerItems("Nicaragua").Selected = False

  .SlicerItems("República Dominicana").Selected = False

  End With

  With ActiveWorkbook.SlicerCaches("Slicer_Área71")

  .SlicerItems("zona1").Selected = True

  .SlicerItems("zona2").Selected = False

  .SlicerItems("zona3").Selected = False

  .SlicerItems("zona4").Selected = False

  .SlicerItems("zona5").Selected = False

  .SlicerItems("Indirectos").Selected = False

  .SlicerItems("zona6").Selected = False

  End With

End If

Sheets("SUB MENÚ").Select

Application.ScreenUpdating = True

End Sub[/CODE]

[size=5][b]infesno_ [/b]

[b]

Utiliza ETIQUETAS para envolver los codigos