Macro no ejecuta en otros libros

Hola experto, quisiera pedirte ayuda con lo siguiente pls
tengo un problema con una macro (que junté de otras macros), la cual quisiera que haga esto:
-Del directorio que pegue el archivo me modifique todos los .xls que contenga la carpeta
-De preferencia que ejecute todo sin actualizar la pantalla para que el código se ejecute más rapido
1. Enliste los archivos que tengo en esa carpeta
2.Abra todos los .xls de la lista generada
3. Ejecute macro (cambiar_con_vlookup_metal_y_buy) a cada hoja (Bom) del libro de la lista (que prácticamente es cambiar valores en celdas pero de la hoja Bom)
4. Guarde cambios del libro especifico y cierre ese libro
EL PROBLEMA ES QUE NO ME EJECUTA "cambiar_con_vlookup_metal_y_buy" EN LOS LIBROS DE LA LISTA Y YA ESTOY DESESPERADO... U.u'
esta es la rutina:
Option Explicit
Sub a_todo() 
Application.ScreenUpdating = False 
Static s As Long, w As Long 
Dim v As Long, r As Long, i As Long, strFile As String 
Dim fso As Variant, ruta, directorio, ficheros, librostd2 As String 
Dim archivo, librostd As String, librodelista As String, libro As String, librostd1 As String 
'Listar archivos 
Set fso = CreateObject("Scripting.FileSystemObject") 
ruta = ActiveWorkbook.Path 
Set directorio = fso.GetFolder(ruta) 
Set ficheros = directorio.Files 
Range("B1").Select 
ActiveCell = "Archivo" 
Range("B2").Select 
For Each archivo In ficheros 
If archivo.Name <> ActiveWorkbook.Name Then 
ActiveCell = archivo.Name 
ActiveCell.Offset(1, 0).Select 
End If 
Next 
Set fso = Nothing 
Set directorio = Nothing 
Set ficheros = Nothing 
'Abrir todos los libros .xls 
Dim MiRuta As String, arcact As String, arch As String 
MiRuta = ActiveWorkbook.Path 
arcact = ActiveWorkbook.Name 
arch = Dir(MiRuta & "\*.xls") 
Do Until arch = "" 
If arch = arcact Then GoTo Salto 
Workbooks.Open Filename:=MiRuta & "\" & arch, UpdateLinks:=False 
Salto: 
arch = Dir 
Loop 
'APLICAR MACRO A LA LISTA 
librostd1 = "S:\SiteData\GDL4\Enclosures\CEC_SESP4\CEC 2011\REFERENCE INFORMATION\STD Validation.xls" 
Workbooks.Open Filename:=librostd1, UpdateLinks:=False, ReadOnly:=True 
librostd2 = "STD Validation.xls" 
librodelista = "aplicar a todos los libros.xls" 
For i = 2 To Range("B2").End(xlDown).Row 
Windows(librodelista).Activate 
libro = Cells(i, 2) 
Cells(i, 3).Value = "OK" 
Cells(i, 4).Value = w 
Windows(libro).Activate 
ActiveWorkbook.Sheets("Bom").Select 
cambiar_con_vlookup_metal_y_buy 
Next 
Application.Calculation = xlCalculationAutomatic 
Windows(librodelista).Activate 
strFile = ActiveWorkbook.FullName 
Windows(librostd2).Close 
Application.ScreenUpdating = True 
End Sub 
'CAMBIAR CON VLOOKUP METAL Y BUY 
Sub cambiar_con_vlookup_metal_y_buy() 
Dim v As Long, r As Long 
Static s As Long, w As Long 
ActiveWorkbook.Sheets("Bom").Activate 
ActiveWorkbook.Sheets("Bom").Select 
For r = 2 To 5999 Step 1 
    If Cells(r, 6).Value <> "" Then w = r 
Next r 
For r = 2 To w Step 1 
If (Cells(r, 6).Value = "Buy" Or Cells(r, 6).Value = "Metal") And (Cells(r, 13).Value = "") Then 
    Cells(r, 9).Value = "" 
    Cells(r, 12).Value = "=+VLOOKUP(RC[-9],'S:\SiteData\GDL4\Enclosures\CEC_SESP4\CEC 2011\REFERENCE INFORMATION\[STD Validation.xls]STD Validation'!C1:C11,11,0)" 
    Cells(r, 12).Select 
    Selection.Copy 
    Cells(r, 12).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
    Application.CutCopyMode = False 
s = 0 
s = r + 1 
Cells(s, 13).Value = "=R[-1]C[-1]*R[-1]C[-2]" 
End If 
Next r 
Calculate 
If ThisWorkbook.Saved = False Then 
    ThisWorkbook.Save 
End If 
ActiveWorkbook.Close savechanges:=True 
End Sub 
Bueno, de antemano, gracias por leer xD

1 respuesta

Respuesta
1
Espero poder ayudarte. ¿Cuándo dice que no se ejecuta es que te sale un error o pasa derecho?. Por favor dame más info acerca de eso.
Si, mira, lo que pasa es que la macro ejecuta todo perfecto hasta la linea (48) de
ActiveWorkbook.Sheets("Bom").Select
pero cuando llama a: cambiar_con_vlookup_metal_y_buy
no se ejecuta sobre la ventana nueva que activó, osea, activa la ventana pero el siguiente "for" (For r = 2 To 5999 Step 1  
    If Cells(r, 6).Value <> "" Then w = r  
Next r) no ejecuta la evaluacion del "IF", por lo tanto, el siguiente "FOR" no lo ejecuta como debiera, y pss tampoco el siguiente "IF" NO LO EJECUTA como yo quisiera:
If (Cells(r, 6).Value = "Buy" Or Cells(r, 6).Value = "Metal") And (Cells(r, 13).Value = "")
Ya después guarda y cierra la ventana activada, osea, todo perfecto excepto esas evaluaciones del "IF", no se en que me estoy equivocando... please.. heeeelppp meee! xD
no se si me doy a entender... bueno, muchas gracias por la atención, je je
Probé la parte del for y hace el if bien. Por que dices que no se ejecuta, ¿El valor de w no es tu esperado? Has probado cambiar_con_vlookup_metal_y_buy en una hoja cualquiera?
Je je, gracias por la atención, je je, mira, lo que pasa es que solucione de momento el problema haciendo referencia completa a la hoja en que yo quería modificar, quedando de esta forma:
For v = 1 To 9000
    If ActiveWorkbook.Sheets("Bom").Cells(v, 6).Value <> "" Then w = v
Next v
For r = 2 To w Step 1
If ((ActiveWorkbook.Sheets("Bom").Cells(r, 6).Value = "Buy") Or _
(ActiveWorkbook.Sheets("Bom").Cells(r, 6).Value = "Metal")) And _
(ActiveWorkbook.Sheets("Bom").Cells(r, 13).Value = "") Then
    ActiveWorkbook.Sheets("Bom").Cells(r, 9).Value = ""
    ActiveWorkbook.Sheets("Bom").Cells(r, 12).Value = "=+VLOOKUP(RC[-9],'S:\SiteData\GDL4\Enclosures\CEC_SESP4\CEC 2011\REFERENCE INFORMATION\[STD Validation.xls]STD Validation'!C1:C11,11,0)"
    ActiveWorkbook.Sheets("Bom").Cells(r, 12).Copy
    ActiveWorkbook.Sheets("Bom").Cells(r, 12).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
Y solo así pude hacer referencia al objeto que yo quería modificar (activeworkbook.sheets...),
ahora solo me falta mejorar la macro de tal forma que no haga operaciones innecesarias, je je, pero eso con calma, gracias a Dios pude hacer mi chamba con la nueva macro "mejorada y aumentada"
Bueno, te pongo 5 estrellas por tu preocupación y atención, jejej, gracias y cuidate, que conste que te preguntare por nuevas dudas que me surjan, ¿ee? XD

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas