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

Respuesta
1

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas