Utilizar un macro que corra en base a nombre de pestaña y no archivos?

Tengo una serie de archivos los cuales utilizo para recolectar informacion y llenar un archivo fuente pero, batallo por que son en base a ventanas activas, mismas que estan referenciadas a los nombres. Quisiera que al correr el macro se ejecute en base al nombre de las pestanas

Respuesta
1

¿Puedes poner un ejemplo de tu código?

1 respuesta más de otro experto

Respuesta
1

Te anexo la macro tal como acordamos por correo, el cambio consiste en determinar el archivo que está abierto, si no está abierto el libro indicado, te envía un mensaje a pantalla.

Sub MPS()
'Act.Por.Dante Amor
' MPS START
'
    Application.ScreenUpdating = False
    For Each wb In Workbooks
        If InStr(1, wb.Name, "GP_PD_MPS_STARTS") > 0 Then
            Set l2 = Workbooks(wb.Name)
            existe = True
            Exit For
        End If
    Next
    '
    If existe = False Then
        MsgBox "El libro ''GP_PD_MPS_STARTS'', no está abierto", vbCritical
        Exit Sub
    End If
    'Windows("GP_PD_MPS_STARTS.xlsx").Activate
    l2.Activate
    '
    Sheets("Sheet1").Select
    Rows("1:1").Select
    Selection.AutoFilter
    Range("F1").Select
    ActiveSheet.Range("$A$1:$AP$12000").AutoFilter Field:=6, Criteria1:= _
        "=*plate*", Operator:=xlAnd
    Range("F2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Rows("2:12000").Select
    Range("F2").Activate
    Selection.Delete Shift:=xlUp
    ActiveSheet.ShowAllData
    Range("O1").Select
    ActiveSheet.Range("$A$1:$AP$12000").AutoFilter Field:=15, Criteria1:= _
        "Current"
    Range("O271").Select
    Range(Selection, Selection.End(xlDown)).Select
    Rows("271:12000").Select
    Range("O271").Activate
    Selection.Delete Shift:=xlUp
    ActiveSheet.ShowAllData
    Range("O270").Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.End(xlUp).Select
    Range("S30").Select
    Range("Z1").Select
    '
    Range("I1").Select
    ActiveSheet.Range("$A$1:$AP$5696").AutoFilter Field:=9, Criteria1:= _
        "Planned"
    Range("E570:H570").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.End(xlUp).Select
    Range("E570").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("E570:G570").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection. Copy
    'Windows("Mexicali Tier III wk5.xlsm").Activate
    ThisWorkbook.Activate
    '
    Range("B35").Select
    ActiveSheet.Paste
    'Windows("GP_PD_MPS_STARTS.xlsx").Activate
    l2.Activate
    '
    Range("L570").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("L570").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection. Copy
    'Windows("Mexicali Tier III wk5.xlsm").Activate
    ThisWorkbook.Activate
    '
    Range("E35").Select
    ActiveSheet.Paste
    'Windows("GP_PD_MPS_STARTS.xlsx").Activate
    l2.Activate
    '
    Range("U570:V570").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection. Copy
    'Windows("Mexicali Tier III wk5.xlsm").Activate
    ThisWorkbook.Activate
    '
    Range("F35").Select
    ActiveSheet.Paste
    'Windows("GP_PD_MPS_STARTS.xlsx").Activate
    l2.Activate
    '
    Range("U1").Select
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    Range("Z570").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection. Copy
    'Windows("Mexicali Tier III wk5.xlsm").Activate
    ThisWorkbook.Activate
    '
    Range("A35").Select
    ActiveSheet.Paste
    Range("A34").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("PD MPS STARTS").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("PD MPS STARTS").AutoFilter.Sort.SortFields.Add Key _
        :=Range("A34"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("PD MPS STARTS").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Application.ScreenUpdating = True
End Sub

Saludos.Dante Amor

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas