Macro para traspasar datos de un archivo excel a otro
Estoy trabajando en una macro que no logro solucionar.
Os explico.
Tengo un archivo "listado" donde, en la hoja "listado productos" tengo cierta información sobre productos. Cada fila (desde la fila 5 hasta la última fila con datos) se corresponde con un producto. Y hay varias columnas de información por cada producto.
Quiero hacer una macro para que me busque todos los productos que cumplen una misma característica (valor de columna "aj"=1), y que los corte de este listado y los pegue a un listado histórico con la misma estructura (mismo número de columnas), pero donde acumulo los productos caducados, por decirlo de alguna manera.
¿Cómo se haría?
Muchísimas gracias de antemano.
Pd.: La macro es algo más complicada, pero planteo aquí la duda concreta que tengo, para no liar mucho la pregunta.
1 Respuesta
Esta es mi propuesta de solución, sigue mi ejemplo:
-Tenemos un archivo llamado listado y dentro de él tenemos la pestaña listado productos
-También tenemos otro archivo llamado (como quieras) que está grabado en el disco y dentro de él tenemos obligatoriamente una pestaña en blanco llamada caducados. (Este último archivo está cerrado)
-Copia esta macro en tu archivo listado y ejecutala. Al ejecutarla te aparece un browse para abrir el segundo archivo, esté donde esté y seguidamente hará lo que pides.
-Al finalizar deja los dos ficheros abiertos.
Sub ejemplo()
'por luismondelo
mio = ActiveWorkbook.Name
archivo = Application.GetOpenFilename
If archivo = False Then Exit Sub
Workbooks.Open archivo
otro = ActiveWorkbook.Name
Workbooks(mio).Activate
Sheets("listado productos").Select
Range("aj65000").End(xlUp).Offset(1, 0).Value = "final"
Range("aj5").Select
Do While ActiveCell.Value <> "final"
If ActiveCell.Value = 1 Then
ActiveCell.EntireRow.Copy
Workbooks(otro).Sheets("caducados").Range("a65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End If
ActiveCell.Offset(1, 0).Select
Loop
End Subrecuerda finalizar la consulta
Gracias por la rapidez. Pero quiero definir el rango de arriba abajo, ya que quiero poner unas filas de totales al final del listado.
Pro tanto, he cambiado:
Range("aj65000").End(xlUp).Offset(1, 0).Value = "final"
por:
Range("aj5").End(xlDown).Offset(1, 0).Value = "final"
Y siguiendo el procedimiento propuesto, me da error justamente ahí.
¿Por qué puede ser?
Gracias.
Perdón.
Me daba error ahí porque estaba sin desproteger la hoja, y por eso no permitía escribir.
Voy a probarlo de nuevo.
Hola,
Funciona, pero veo un problema.
Cada vez que corro la macro, me escribe "final" una casilla más abajo, porque busca la última celda vacía, la cual está cada vez más abajo.
¿Cómo puedo solucionar esto?
Gracias.
tienes que poner la siguiente sentencia al final de la macro justo antes de end sub
Activecell. Clearcontents
Recuerda finalizar la consulta
Ok. Ya sé que ese comando borra el contenido. Pero tengo que pensar una
forma para ir a esa casilla al finalizar la macro. Lo que voy a hacer es quitar lo de dar value = final, y dejarlo escrito en el listado.
Gracias.
