Macro de Excel para automatizar tarea repetitiva
Soy nuevo en el foro y necesito ayuda para crear una macro para que me ayude a automatizar una tarea rutinaria que tengo que hacer bastantes veces al día. Voy a intentar explicarlo para que quede lo más claro posible.
- Libro A : archivo excel donde ejecutar la macro.
- Libro B: En el se encuentran los datos de entrada para la macro:
- Hoja 1: datos de rutas marcas:
- Columna A: Marca.
- Columna B: vínculo a la ubicación del archivo de la marca (hay un archivo para cada marca y esta en una carpeta diferente)
- hoja 2: datos que introduzco para las órdenes.
- Libro C: Archivo correspondiente a cada Marca, la macro ha de crear copia(s) de la última hoja de este libro.
A continuación voy a explicar lo que me gustaría poder automatizar:
- Abro el libro B (hoja 2) y creo una o varias filas, a las cuales les asigno un número de orden (columna D), una Marca (columna C) y una descripción (columna E). En la columna F indica si se ha creado la orden correspondiente o no mediante la palabra "SI".
- Al ejecutar la macro (Libro A) debería de hacer lo siguiente:
- Para todas las filas que no tengan la palabra "SI" (Libro B, hoja 2, columna F), es decir, que no se ha creado la orden.
- Abrir el archivo (libro C) de la Marca correspondiente, y copiar la última hoja al final, nombrándola con el número de orden que le indico al introducir los datos en el Libro B. Y en esta hoja copiar:
- el número de orden en celda A1.
- La descripción en celda A2.
1 Respuesta
Te anexo la macro. Debes mantener los libros A y B abiertos.
Pon la macro en el libro A.
Cambia en la macro "Libro B.xlsx" por el nombre de tu libro B.
La macro revisará si puede abrir el libro C, si no puede abrir el libro te pondrá un mensaje en la hoja2, en la columna F.
Si pudo abrir el libro C, entonces copiará la hoja y te pondrá un "SI" en la columna F.
Sub Automatizar_Tarea()
'
' Por Dante Amor
'
'Abrir archivo de acuerdo a la marca y copiar la última hoja
'
Application.ScreenUpdating = False
Set l1 = ThisWorkbook 'libro con la macro
Set l2 = Workbooks("Libro B.xlsx") 'libro con datos de entrada
Set h21 = l2.Sheets(1) 'Hoja 1: datos de rutas marcas
Set h22 = l2.Sheets(2) 'hoja 2: datos que introduzco para las órdenes
'
For i = 2 To h22.Range("C" & Rows.Count).End(xlUp).Row
marca = h22.Cells(i, "C").Value
orden = h22.Cells(i, "D").Value
descr = h22.Cells(i, "E").Value
conti = h22.Cells(i, "F").Value
If UCase(conti) <> "SI" Then
Set b = h21.Columns("A").Find(marca, lookat:=xlWhole)
If Not b Is Nothing Then
If h21.Cells(b.Row, "B").Value = "" Then
h22.Cells(i, "F").Value = "No existe vínculo para esta marca"
Else
On Error Resume Next
b.Offset(0, 1).Hyperlinks(1).Follow
num = Err.Number
If num = 13 Or num = 0 Then
Set l3 = ActiveWorkbook
hojas = l3.Sheets.Count
l3.Sheets(hojas).Copy after:=l3.Sheets(hojas)
ActiveSheet.Name = orden
ActiveSheet.Range("A1").Value = orden
ActiveSheet.Range("A2").Value = descr
l3.Close True
h22.Cells(i, "F").Value = "SI"
Else
h22.Cells(i, "F").Value = "No se pudo abrir el hipervínculo"
End If
Err.Clear
On Error GoTo 0
End If
Else
h22.Cells(i, "F").Value = "No existe la marca en la hoja1"
End If
End If
Next
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
¡Gracias!
Ahora mismo lo voy a probar
Buenos días,
Me funciona, pero sólo a veces. Me lanza el error "error 1004 en tiempo de ejecución" y al darle a depurar se posiciona en la línea. Muchas gracias de nuevo.
For i = 2 To h22.Range("C" & Rows.Count).End(xlUp).Row
¿Qué más dice el mensaje de error?
Puedes poner una imagen de tu hoja2 del libroB
Buenos días,
adjunto imagen del error y de la hoja 2 del libroB.
A continuación copio el código de la macro:
Sub Crear_Pedido()
'Abrir archivo de acuerdo al CLIENTE y copiar la última hoja
Application.ScreenUpdating = False
Set l1 = ThisWorkbook 'libro con la macro
Set l2 = Workbooks("LISTADO DE PEDIDOS.xls") 'libro con datos de entrada
Set h21 = l2.Sheets(1) 'DATOS: datos de rutas CLIENTES
Set h22 = l2.Sheets(2) 'PEDIDOS EN FIRME: datos que introduzco para crear PEDIDOS
'
For i = 2 To h22.Range("C" & Rows.Count).End(xlUp).Row
cliente = h22.Cells(i, "C").Value
pedido = h22.Cells(i, "D").Value
descr = h22.Cells(i, "E").Value
conti = h22.Cells(i, "F").Value
If UCase(conti) <> "SI" Then
Set b = h21.Columns("A").Find(cliente, lookat:=xlWhole)
If Not b Is Nothing Then
If h21.Cells(b.Row, "B").Value = "" Then
h22.Cells(i, "F").Value = "No existe vínculo para este cliente"
Else
On Error Resume Next
b.Offset(0, 1).Hyperlinks(1).Follow
num = Err.Number
If num = 13 Or num = 0 Then
Set l3 = ActiveWorkbook
hojas = l3.Sheets.Count
l3.Sheets(hojas).Copy before:=l3.Sheets(hojas)
ActiveSheet.Name = pedido
ActiveSheet.Range("B1").Value = pedido
ActiveSheet.Range("B2").Value = descr
l3.Close True
h22.Cells(i, "F").Value = "SI"
Else
h22.Cells(i, "F").Value = "No se pudo abrir la Valoración"
End If
Err.Clear
On Error GoTo 0
End If
Else
h22.Cells(i, "F").Value = "No existe la marca en la hoja1"
End If
End If
Next
Application.ScreenUpdating = True
MsgBox "Se han creado los Pedidos Pendientes"
End Sub
Ya sé, que lo ideal sería que estuviera la macro en el libro B, pero es un libro compartido.
Gracias por la ayuda.
Cuando te envía el error, abrió algún archivo del hipervínculo, ¿o sucede cuando no pudo abrir algún archivo?
¿Cuándo se detiene la macro? Puedes describir paso a paso qué es lo que sí hizo y en qué momento se detiene.
No, cuando da el error no hace nada. Si le doy a depurar se posiciona en la línea
For i = 2 To h22.Range("C" & Rows.Count).
¿Entonces siempre aparece el error?
¿Nunca abrió ningún archivo?
Puedes ejecutar la macro paso a paso con F8
¿Todas tus marcas tienen hipervínculo?
¿Todos los hipervínculos tienen un archivo que exista?
Puedes probar la macro con una sola marca y que es marca tenga hipervínculo y que le hipervículo funcione, es decir, presiona el hipervínculo y te debe abrir el archivo.
