Ejecutar macro con una lista de nombres

Esta es la macro con la que ojala me puedan ayudar, me imagino que con verla sabes lo que hace pero igual te lo describo muy rapido

• Filtra todos los comercios que estén en la “hoja2” que sean de la ruta en este caso “Veracruz Puerto” filtrando la columna 31 o “AF”, copia todo y lo pega en la hoja 1, después tengo otras macros que hacen lo demás
• El problema es que no solo tengo 1 ruta sino 105 más y claro pueden convertirse en más, en menos o cambiar de nombre por lo que tenía la intención de hacerlo de manera automática, pero no sé si esto sea posible con esta misma macro, por ejemplo que con seleccionar el nombre de la ruta en una lista de validación de datos o algo así

MACRO FILTRA COPIA Y PEGA

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Application.EnableEvents = False

ActiveSheet.DisplayPageBreaks = False

    Sheets("Hoja1").Select

    Range("a12:bc500").ClearContents

    Sheets("Hoja2").Select

    Range("B3").Select

    Selection.AutoFilter

    ActiveSheet.Range("$B$2:$AM$1000000").AutoFilter Field:=31, Criteria1:= _

    "VERACRUZ PUERTO"

    ActiveSheet.Range("$B$2:$AM$1000000").AutoFilter Field:=5, Criteria1:=Array( _

        "Activo", "Afiliado", "cancelado", "reverso"), Operator:=xlFilterValues

    ActiveSheet.Range("$B$2:$AM$9688").AutoFilter Field:=14, Criteria1:=Array( _

        "="), Operator:=xlFilterValues, Criteria2:=Array(1, "10/8/2017")

    Range("B3").Select

    Range(Selection, Selection.End(xlDown)).Select

    Selection.Copy

    ActiveSheet.Previous.Select

    Range("D12").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    For Each Hoja In Array("Hoja2")

    If Sheets(Hoja).AutoFilterMode Then Sheets(Hoja).AutoFilterMode = 0

Next

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

Application.EnableEvents = True

ActiveSheet.DisplayPageBreaks = True

Application.CutCopyMode = False

End Sub