Exportar datos a excels nuevos con fotos
Leo mucho por aquí y aprendo mucho.
Tengo una tabla excel de unas 400 líneas y columnas de la A hasta la Z.La primera fila son encabezados y también me gustaría que se copiaran siempre.
En la columna QUE hay fotos encuadradas dentro de la casilla que también deberían copiarse, y mantener el aspecto, ya que he encontrado alguna opción, pero se movía todo, entonces si tengo que tocar 1 a 1 no me vale.
El fichero esta ordenado por marca que esta en la columna W.
Lo que quisiera pero no he encontrado exactamente lo que necesito, es una macro que lea la columna W, y copie las filas en las que los datos son iguales, en otro excel. Y que ese otro excel se llame como dato leído en la columna W. Y que haga tantos excels como datos distintos en la columna W.
Por ejemplo si son marcas de bebida, las filas en las que la columna W ponga COCA COLA todas en otro excel, junto con el encabezado claro, y su foto que también esta en la fila. Las que ponga FANTA en otro excel, etc etc. Por supuesto esta ordenado por dicha columna.
Y si pudiera añadir una columna con la ruta a escribir donde se guarden todos los excels, por ejemplo al final columna AB, ya seria genial.
1 Respuesta
Realiza lo siguiente
- Cambia en la macro "fotos" por el nombre de tu hoja que contiene los registros.
- Antes de ejecutar la macro crea una hoja nueva y le pones por nombre "temp"
- Para que las imágenes se copien y se peguen, manteniendo su aspecto, en las propiedades de cada imagen deberá estar seleccionada la opción: Mover y cambiar tamaño con celdas.
- En la celda AB1 pon la ruta, si la ruta no existe o no pones la ruta en la celda AB1, la macro tomará por default la ruta donde tienes el archivo con la macro.
- La macro completa:
Sub Separar_Datos()
'----
'Por.Dante Amor
'----
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = Sheets("fotos") 'hoja con registros
Set h2 = Sheets("temp") 'hoja temporal
h2.Cells.Clear
col = "W"
n = Columns(col).Column
If h1.AutoFilterMode Then h1.AutoFilterMode = False
h1.Columns(col).Copy h2.[A1]
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
h2.Range("A1:A" & u2).RemoveDuplicates Columns:=1, Header:=xlYes
'
ruta = h1.Range("AB1")
If ruta = "" Then
ruta = l1.Path & "\"
Else
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
If Dir(ruta, vbDirectory) = "" Then
ruta = l1.Path & "\"
End If
End If
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
grupo = h2.Cells(i, "A")
If h1.AutoFilterMode Then h1.AutoFilterMode = False
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("A1:Z" & u1).AutoFilter Field:=n, Criteria1:=grupo
'u3 = h1.Range("A" & Rows.Count).End(xlUp).Row
Set l2 = Workbooks.Add
Set h21 = l2.Sheets(1)
'h1.Range("A1:Z" & u1).Copy h21.[A1]
h1.Cells.Copy h21.[A1]
l2.SaveAs ruta & grupo
l2.Close
Next
If h1.AutoFilterMode Then h1.AutoFilterMode = False
MsgBox "Archivos creados"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Muchísimas gracias por la rapidez, la he probado, pero me dice error en esta línea después de un buen rato de pensar.
h1.Cells.Copy h21.[A1]
Una vez más muchísima gracias :)
¿Y qué te dice el mensaje de error?
Cambia esta línea
h1.Cells.Copy h21.[A1]
Por esta
H1. Cells. Copy h21. Range("A1")
Voy a probar a ver que tal, el error me decía "depurar línea" nada más y me marcaba esa en el VBA.
Gracias
Este es el error que me da de nuevo
GRACIAS
¿Qué versión de excel tienes?
¿Es de windows o de mac?
¿La maco te creó un nuevo libro?
¿Qué características tiene tu hoja diferente a una hoja normal?
- ¿Tienes la hoja protegida
- Celdas combinadas
- Columnas ocultas
- Filas ocultas
- Algo?
Hola Dante,
Ayer al final ya cerré, disculpa! De nuevo muchas gracias!
Tengo Excel 2016. Windows 7. y la macro se queda pensando, hace intento de crear nuevo libro, pero no lo hace.
Creo que no esta protegida
Hay celdas con categorías que se cogen de otra hoja, es decir un desplegable. Pero si eso no se copia me da igual.
Hay algunas ocultas, pero también puedo mostrarlas, y eliminarlas si hace falta.
GRACIAS
Sin duda es tu versión 2016.
Prueba esta macro para crear un libro
Sub crear_libro() Set l2 = Workbooks.Add End Sub
Te debe crear un nuevo libro, avísame qué hace.
Muchas gracias Dante, al final lo que he hecho ha sido eliminar las pestañas que me creaban categorías, y eliminar todas las posibles cosas que dieran problemas. También he eliminado las fotos, porque se me colgaba ya que la memoria virtual se agotaba.
De la columna W salen unos 60 libros, por lo que tarda bastante, pero finalmente los hace todos.
Lo único es que me descuadra las columnas y filas, hay alguna manera de hacer que el alto y ancho de las filas del original, se mantengan en los ficheros nuevos creados?
De nuevo muchas gracías he descubierto esta gran comunidad que espero me ayude a resolver muchas cosas e iniciarme en el VBA
saludos
