Macro en Excel, crear hojas con información

He buscado tutoriales para crear una macro en la que pueda crear hojas de calculo, que al momento de ejecutar la macro me pida como quiero ponerle de nombre a la hoja y ese nombre me compare con todos los que tengo en la columna D y automáticamente me pace la información correspondiente de dicho nombre a la hoja nueva creada, tanto de la columna A, B, C, D, E, F, G, H. En caso de que ya exista la hoja que solo me arrastre la información de dicha hoja que ya existe.., ¿podran ayudarme con este gran problema?

https://github.com/jonathan-19/MacroParaExcel 

Respuesta
1

Esto lo puedes conseguir con programación, pero sería bastante más limpio utilizar una tabla dinámica, o simplemente aplicar un autofiltro y copiar&pegar a mano.

Si aún así quieres hacerlo con código una forma de montarlo podría ser:

Sub Ejemplo()
Application.Calculation = xlCalculationManual 'Esto es para que vaya un poco más rápido, cambia el modo de calculo a manual
Dim NombreHojaBaseDatos, Fila, Columna, UltimaColumna, FilaDestino
NombreHojaBaseDatos = ActiveSheet.Name
Sheets.Add
ActiveSheet.Name = InputBox("Introduca el nombre de la nueva hoja ")
Fila = 1
UltimaColumna = 8 'Termina en la columna H
FilaDestino = 1
While Not Worksheets(NombreHojaBaseDatos).Cells(Fila, 4).Value = "" 'seguira ejecutando hasta que la columna D aparezca en blanco
    If ((Fila = 1) Or (Worksheets(NombreHojaBaseDatos).Cells(Fila, 4).Value = ActiveSheet.Name)) Then
        For Columna = 1 To UltimaColumna 'Empieza en la columna A y recorres hasta la H
            ActiveCell.Cells(FilaDestino, Columna).Value = Worksheets(NombreHojaBaseDatos).Cells(Fila, Columna).Value
        Next
        FilaDestino = FilaDestino + 1
    End If
    Fila = Fila + 1
Wend
Application.Calculation = xlCalculationAutomatic
MsgBox ("Proceso Finalizado")
End Sub

Eso sí, en caso de que la bbdd sea muy grande paciencia...
Si te decides a hacerlo programando y te de algún problema este código avisme porque hay infinitas formas de programarlo, esta es solo una.

Al momento de cancelar al crear una hoja me marca error

Dentro de este ejemplo: https://github.com/jonathan-19/MACRO 

Agregue más especificado a lo que quiero llegar, la verdad no se si se pueda, me podrá ayudar :/

Es para optimizar el trabajo

Hay varios problemas, vamos de más fácil a más difícil:

  1. Si la hoja ya existe la macro que te hice antes no sirve (fallo mío)
    Abajo te he pegado un código nuevo, en caso de que la hoja ya exista la elimina y la vuelve a crear. Lo he programado así porque es más sencillo crearla de 0 que comprobar todos los datos y copiar solo los nuevos.
    También he aprovechado para adaptarlo a tu archivo.
  2. Un nombre de hoja no puede empezar por <espacio>, y por lo tanto ningún valor de la columna D puede empezar por espacio.
    Esto también se soluciona fácil, de hecho en el módulo 6 tienes una macro que elimina los espacios ( ojo que solo llega hasta la fila 56)
  3. El nombre de una hoja no puede ser más largo de 31 caracteres. Y esto sí que es un problema porque la mayoría de valores que tienes en la columna DE son bastante más largos que 31 caracteres. Si quieres trabajar por hojas deberías acortar esos nombres.
    Si esto no es posible tendrás que utilizar alias o cambiar a otro sistema ( podrías trabajar con tablas dinámicas por ejemplo).

El código para resolver el punto 1 es el siguiente:

Puntos 2 y 3 están en tus manos.

Sub Ejemplo()
Application.Calculation = xlCalculationManual 'Esto es para que vaya un poco más rápido, cambia el modo de calculo a manual
Dim NombreHojaBaseDatos, Fila, Columna, UltimaColumna, FilaDestino, LaHojaExiste, NombreHoja
NombreHojaBaseDatos = ActiveSheet.Name
NombreHoja = InputBox("Introduca el nombre de la nueva hoja ")
LaHojaExiste = ExisteHoja(NombreHoja)
If LaHojaExiste = True Then
    Worksheets(NombreHoja).Delete
End If
Sheets.Add
ActiveSheet.Name = NombreHoja
Fila = 10
UltimaColumna = 8 'Termina en la columna H
FilaDestino = 1
While Not Worksheets(NombreHojaBaseDatos).Cells(Fila, 4).Value = "" 'seguira ejecutando hasta que la columna D aparezca en blanco
    If ((FilaDestino = 1) Or (Worksheets(NombreHojaBaseDatos).Cells(Fila, 4).Value = ActiveSheet.Name)) Then
        For Columna = 1 To UltimaColumna 'Empieza en la columna A y recorres hasta la H
            ActiveCell.Cells(FilaDestino, Columna).Value = Worksheets(NombreHojaBaseDatos).Cells(Fila, Columna).Value
        Next
        FilaDestino = FilaDestino + 1
    End If
    Fila = Fila + 1
Wend
Application.Calculation = xlCalculationAutomatic
MsgBox ("Proceso Finalizado")
End Sub
Function ExisteHoja(NombreNuevaHoja)
Dim Ws As Worksheet
Dim R As Boolean
R = False
For Each Ws In ActiveWorkbook.Worksheets
If Ws.Name = NombreNuevaHoja Then R = True
Next
ExisteHoja = True
End Function

Me marca error en 

Worksheets(NombreHoja).Delete

en mi caso no  me es fácil eliminar la hoja que ya tengo y crear otra desde 0 por que también voy a utilizar la información de antes y la actual

¿Qué dice el error?

Si no puedes eliminar la hoja anterior entonces tendras que cambiar de sistema porque un mismo excel no puede tener varias hojas con el mismo nombre.

Se podría programar para que cree la hoja en un libro nuevo por ejemplo.

https://github.com/jonathan-19/MACRO2  a qui esta el error botón que dice ejemplo 2 , modulo 8

entonces no se puede crear una macro para que al momento de crear la hoja con el nombre en especifico automáticamente se cree la hoja con su respectiva información??

En cuanto al error: Mea culpa la línea que dice ExisteHoja=True debebería haber sido un ExisteHoja=R te copio el código completo corregido más abajo.

Respondiendo a tu pregunta: Lo que no puedes es llamar igual a dos hojas del mismo libro ni tener nombres de hojas de más de 31 carácteres.
Si por ejemplo borras la línea de código que dice

ActiveSheet.Name=NombreHoja 

y cambias el trozo

If ((FilaDestino = 1) Or (Worksheets(NombreHojaBaseDatos).Cells(Fila, 4).Value = ActiveSheet.Name))

por

If ((FilaDestino = 1) Or (Worksheets(NombreHojaBaseDatos).Cells(Fila, 4).Value = NombreHoja))

La macro hará exactamente lo que tu quieres pero las hojas se llamarán Hoja2, Hoja3 ... etc

¿Me entiendes?

Sub Ejemploo()
Application.Calculation = xlCalculationManual 'Esto es para que vaya un poco más rápido, cambia el modo de calculo a manual
Dim NombreHojaBaseDatos, Fila, Columna, UltimaColumna, FilaDestino, LaHojaExiste, NombreHoja
NombreHojaBaseDatos = ActiveSheet.Name
NombreHoja = InputBox("Introduca el nombre de la nueva hoja ")
LaHojaExiste = ExisteHoja(NombreHoja)
If LaHojaExiste = True Then
    Worksheets(NombreHoja).Delete
End If
Sheets.Add
ActiveSheet.Name = NombreHoja
Fila = 10
UltimaColumna = 8 'Termina en la columna H
FilaDestino = 1
While Not Worksheets(NombreHojaBaseDatos).Cells(Fila, 4).Value = "" 'seguira ejecutando hasta que la columna D aparezca en blanco
    If ((FilaDestino = 1) Or (Worksheets(NombreHojaBaseDatos).Cells(Fila, 4).Value = ActiveSheet.Name)) Then
        For Columna = 1 To UltimaColumna 'Empieza en la columna A y recorres hasta la H
            ActiveCell.Cells(FilaDestino, Columna).Value = Worksheets(NombreHojaBaseDatos).Cells(Fila, Columna).Value
        Next
        FilaDestino = FilaDestino + 1
    End If
    Fila = Fila + 1
Wend
Application.Calculation = xlCalculationAutomatic
MsgBox ("Proceso Finalizado")
End Sub
Function ExisteHoja(NombreNuevaHoja)
Dim Ws As Worksheet
Dim R As Boolean
R = False
For Each Ws In ActiveWorkbook.Worksheets
If Ws.Name = NombreNuevaHoja Then R = True
Next
ExisteHoja = R
End Function

Excelente

Se puede modificar la macro para el detalle de los 31 caracteres que permite excel

¿Si solamente nombro a la hoja SERGIO ARTURO me traiga la información de SERGIO ARTURO CABRERA PEÑA?

o que pueda ser cualquier nombre se puede modificar?

De poder se puede, pero te arriesgas a coger información de más. Por ejemplo si tuvieras en D el valor "SERGIO ARTURO CABERA PEÑA" y en otras filas el valor "SERGIO ARTURO ROJAS" correspondiente a una categoría totalmente distinta, al crear la hoja como "SERGIO ARTURO" la macro te arrastraría la información de ambos indistintamente.

si entiendo, pero me podrías decir como quedaría?, correré con el riesgo  

Ya que insistes...

La único que cambia es que después de introducir el nombre de la hoja cuenta los caracteres

LargoNombre = Len(NombreHoja)

Y luego al comparar en el recorrido compara solo ese número de caracteres contando desde la izquierda:

Left(Worksheets(NombreHojaBaseDatos). Cells(Fila, 4).Value, LargoNombre) = ActiveSheet. Name

Aquí tienes el código completo:

Sub Ejemplo()
Application.Calculation = xlCalculationManual 'Esto es para que vaya un poco más rápido, cambia el modo de calculo a manual
Dim NombreHojaBaseDatos, Fila, Columna, UltimaColumna, FilaDestino, LaHojaExiste, NombreHoja, LargoNombre
NombreHojaBaseDatos = ActiveSheet.Name
NombreHoja = InputBox("Introduca el nombre de la nueva hoja ")
LargoNombre = Len(NombreHoja)
LaHojaExiste = ExisteHoja(NombreHoja)
If LaHojaExiste = True Then
    Worksheets(NombreHoja).Delete
End If
Sheets.Add
ActiveSheet.Name = NombreHoja
Fila = 10
UltimaColumna = 8 'Termina en la columna H
FilaDestino = 1
While Not Worksheets(NombreHojaBaseDatos).Cells(Fila, 4).Value = "" 'seguira ejecutando hasta que la columna D aparezca en blanco
    If ((FilaDestino = 1) Or (Left(Worksheets(NombreHojaBaseDatos).Cells(Fila, 4).Value, LargoNombre) = ActiveSheet.Name)) Then
        For Columna = 1 To UltimaColumna 'Empieza en la columna A y recorres hasta la H
            ActiveCell.Cells(FilaDestino, Columna).Value = Worksheets(NombreHojaBaseDatos).Cells(Fila, Columna).Value
        Next
        FilaDestino = FilaDestino + 1
    End If
    Fila = Fila + 1
Wend
Application.Calculation = xlCalculationAutomatic
MsgBox ("Proceso Finalizado")
End Sub
Function ExisteHoja(NombreNuevaHoja)
Dim Ws As Worksheet
Dim R As Boolean
R = False
For Each Ws In ActiveWorkbook.Worksheets
If Ws.Name = NombreNuevaHoja Then R = True
Next
ExisteHoja = R
End Function

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas