Jump to content
Deima Ordenadores

Filtrar y copiar resultados en hojas diferentes

Recommended Posts

Buenas tardes a todos,

Tengo una Tabla y quisiera a traves de una macro 
que todos los datos que tengo en una columna repetidos
se me copien en hojas diferentes con el mismo nombre que los datos.

Ejemplo: en la Columna F "Categoria" tengo los siguientes datos
SSD, Procesadores, Altavoces, Tablets, etc... y cada uno de ellos
necesito que se copien en hojas separadas con los nombres
de cada una SSD, Procesadores, Altavoces, Tablets, etc...

Saludos

Importador1.xlsm

Share this post


Link to post
Share on other sites

Prueba con esto:

Sub HojasPorCategoría()
Application.ScreenUpdating = False
Set dmi = Sheets("DMI")
For x = 2 To dmi.UsedRange.Rows.Count
   If Existe(dmi.Range("F" & x).Value) = False Then
      Sheets.Add.Name = dmi.Range("F" & x).Value
      dmi.Rows(1).Copy
      ActiveSheet.Paste
   End If
   With Sheets(dmi.Range("F" & x).Value)
      dmi.Rows(x).Copy .Rows(.Range("A" & Rows.Count).End(xlUp).Row + 1)
   End With
Next
End Sub
'-------------------------------------------------
Private Function Existe(Hoja As String) As Boolean
On Error GoTo ExitFunction
Sheets(Hoja).Select
Existe = True
Exit Function
ExitFunction:
End Function

 

Share this post


Link to post
Share on other sites

Muchas gracias Antoni por tu tiempo e interes, ha funcionado perfectamente en este ejemplo que he puesto.

Pero realmente el fichero original contiene mas de 80 datos en la Columna F "Categoria" y yo solo necesito unos 10.
Lo que hice manualmente para subir el fichero de ejemplo fue filtrar la columna F "Categorias" con los datos:
SSD, Procesadores, Altavoces, Tablets y borrar todos los demas datos a mano.

¿Crees que se podria hacer lo mismo pero copiando los datos que yo elija con el AutoFiltro de la Columna F "Categorias" ?


Saludos

Filtro Categorias.png

Share this post


Link to post
Share on other sites
Sub HojasPorCategoría()
Application.ScreenUpdating = False
Set dmi = Sheets("DMI")
For x = 2 To dmi.UsedRange.Rows.Count
   If Rows(x).Hidden = False Then
      If Existe(dmi.Range("F" & x).Value) = False Then
         Sheets.Add.Name = dmi.Range("F" & x).Value
         dmi.Rows(1).Copy
         ActiveSheet.Paste
      End If
      With Sheets(dmi.Range("F" & x).Value)
         dmi.Rows(x).Copy .Rows(.Range("A" & Rows.Count).End(xlUp).Row + 1)
      End With
   End If
Next
End Sub
'-------------------------------------------------
Private Function Existe(Hoja As String) As Boolean
On Error GoTo ExitFunction
Sheets(Hoja).Select
Existe = True
Exit Function
ExitFunction:
End Function

 

Share this post


Link to post
Share on other sites

Muchas gracias Antoni,

La Macro que me has puesto funciona perfectamente cuando tengo marcados en la Columna F "Categoria" todos los datos.

Pero como te he dicho anteriormente de los 80 datos solo me pueden interesar 10, los marco, ejecuto tu Macro y 

me crea todas las Hojas aunque no esten marcadas, eso si sin datos pero me crea las 70 Hojas vacias y las que he marcado

si que tienen los datos que tienen que tener.

Saludos

Share this post


Link to post
Share on other sites

Muchas gracias Antoni por perder tiempo conmigo,

Efectivamente tal y como me has enviado el fichero Importador (1).xlsm funciona con todas las opciones del filtro

me lo copia y crea las Hojas adecuadas.

Pero lo que yo hago es copiar la macro que me has puesto y la pongo en Modulos y desde hay no funciona como debe

me copia todos los filtros aunque no esten marcados a Hojas Nuevas.

Este es tu código pero copiado a un Modulo:

577722680_Captura1.thumb.PNG.f89a551239b8504bb4ce000de8d8afa1.PNG

Lo ejecuto desde Modulo y hay es donde falla.

Yo todas las pruebas que he hecho es pasando tu código a un nuevo Modulo grabado en PERSONAL.XLSB y desde hay lo ejecuto

y es cuando el copiado me lo hace mal.

Saludos,

Share this post


Link to post
Share on other sites

Error mio, me he olvidado de calificar un rango, mis disculpas.

Sub HojasPorCategoría()
Application.ScreenUpdating = False
Set dmi = Sheets("DMI")
For x = 2 To dmi.UsedRange.Rows.Count
   If dmi.Rows(x).Hidden = False Then '<----------------------------------------
      If Existe(dmi.Range("F" & x).Value) = False Then
         Sheets.Add.Name = dmi.Range("F" & x).Value
         dmi.Rows(1).Copy
         ActiveSheet.Paste
      End If
      With Sheets(dmi.Range("F" & x).Value)
         dmi.Rows(x).Copy .Rows(.Range("A" & Rows.Count).End(xlUp).Row + 1)
      End With
   End If
Next
End Sub
'-------------------------------------------------
Private Function Existe(Hoja As String) As Boolean
On Error GoTo ExitFunction
Sheets(Hoja).Select
Existe = True
Exit Function
ExitFunction:
End Function

 

 

Edited by Antoni

Share this post


Link to post
Share on other sites
Guest Cacho R
Hace 1 hora, Antoni dijo:

me he olvidado de calificar un rango, mis disculpas.

Por mi parte: ¡Estás disculpado!...

Share this post


Link to post
Share on other sites

@Antoni, Es increíble lo fácil que haces lo difícil. Me he guardado el código porque me puede ser útil en el futuro.

Aunque te pueda parecer tonto me he tenido que estudiar el código a papel y lápiz, paso a paso, y me ha costado un buen rato enterarme.

Cuando me he "enterado" me he dicho. Increíble, si todo es pura lógica y matemática.

Buscas la hoja, si no la encuentras la creas, y si la encuentra salta el bucle. Luego como el nombre de la hoja la dejas en una variable la utilizas para abrir la hoja que tiene ese nombre. Como ya existe no hay problema. Y ahí en la primera fila sin datos pegas la fila del bucle donde buscabas la hoja. Siempre con los valores filtrados. Todo esto en cuatro líneas de código.

Pues esto que parece fácil, te digo que me ha llevado un buen rato entenderlo.

Debo decirte a ti y al resto de maestros que la ayuda que nos prestáis de manera altruista no está suficientemente reconocida. Y a veces pecamos de no saber pedir bien la ayuda o nos pierden las maneras.

Así que solo decirte y deciros que muchas gracias!!

Moisés.

 

Share this post


Link to post
Share on other sites
Hace 21 horas, Antoni dijo:

Error mio, me he olvidado de calificar un rango, mis disculpas.

Sub HojasPorCategoría()
Application.ScreenUpdating = False
Set dmi = Sheets("DMI")
For x = 2 To dmi.UsedRange.Rows.Count
   If dmi.Rows(x).Hidden = False Then '<----------------------------------------
      If Existe(dmi.Range("F" & x).Value) = False Then
         Sheets.Add.Name = dmi.Range("F" & x).Value
         dmi.Rows(1).Copy
         ActiveSheet.Paste
      End If
      With Sheets(dmi.Range("F" & x).Value)
         dmi.Rows(x).Copy .Rows(.Range("A" & Rows.Count).End(xlUp).Row + 1)
      End With
   End If
Next
End Sub
'-------------------------------------------------
Private Function Existe(Hoja As String) As Boolean
On Error GoTo ExitFunction
Sheets(Hoja).Select
Existe = True
Exit Function
ExitFunction:
End Function

 

 

Disculpado y muy agradecido por tu interés.

Ahora funciona perfectamente

Hace 20 horas, Pirtrafilla dijo:

@Antoni, Es increíble lo fácil que haces lo difícil. Me he guardado el código porque me puede ser útil en el futuro.

Aunque te pueda parecer tonto me he tenido que estudiar el código a papel y lápiz, paso a paso, y me ha costado un buen rato enterarme.

Cuando me he "enterado" me he dicho. Increíble, si todo es pura lógica y matemática.

Buscas la hoja, si no la encuentras la creas, y si la encuentra salta el bucle. Luego como el nombre de la hoja la dejas en una variable la utilizas para abrir la hoja que tiene ese nombre. Como ya existe no hay problema. Y ahí en la primera fila sin datos pegas la fila del bucle donde buscabas la hoja. Siempre con los valores filtrados. Todo esto en cuatro líneas de código.

Pues esto que parece fácil, te digo que me ha llevado un buen rato entenderlo.

Debo decirte a ti y al resto de maestros que la ayuda que nos prestáis de manera altruista no está suficientemente reconocida. Y a veces pecamos de no saber pedir bien la ayuda o nos pierden las maneras.

Así que solo decirte y deciros que muchas gracias!!

Moisés.

 

No puedo estar mas de acuerdo contigo.

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png