Crear nuevas hojas en base a una columna

[Hola

Excel solo permite crear 255 hojas y pides crear más 400

Hola Adriel, 

Gracias por tu respuesta, pero entiendo que en las versiones antiguas de Excel no se podía, en las versiones actuales no hay límites; excepto el límite que impone la propia memoria de la computadora. 

Gracias favor su ayuda, y comento nuevamente, con el complemento lo pude hacer, me separo la base de datos en 400 hojas, pero la idea es tener mi propio procedimiento.

Explica con imágenes de la hoja donde tienes tus datos (prepara algo ficticio para ver y preparar la macro)

Perfecto :)

.... Espero que se logre ver la imagen.

Me gustaría tener un procedimiento que realice lo siguiente:

• El rango (A1:P1) son encabezados, y esos deben copiarse a todas las hojas
• La columna A es la llave, por cada "Rut" debería generar un nueva hoja.
• Según el ejemplo se deberian generar 6 hojas al archivo, una por cada "Rut"
• El total de filas y "Rut" es variable

Gracias de antemano, indicame si necesitas algo más.

Muchas gracias

Me falto agregar que cada nueva hoja sea nombrada con el Rut que se está agregando.

Me explico, siguiendo mi ejemplo, la nueva "hoja 2" debería llamarse "11111111-8", la nueva "hoja3" debería llamarse "22222222-9", y así sucesivamente.

Muchas gracias,

Si ya no tienes dudas valoras esta respuesta para finalizar

Macro

Sub crearhoja()
    'Adriel doMangie
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets.Add
    '
    On Error Resume Next
    u = h1.Range("A" & Rows.Count).End(xlUp).Row
    u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
    h1.Range("A2:A" & u).Copy h2.Range("A1")
    h2.Range("$A$1:$A$" & u).RemoveDuplicates Columns:=1, Header:=xlNo
    '
    i = 1
    Do While h2.Cells(i, 1) <> ""
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = h2.Cells(i, 1)
        i = i + 1
    Loop
    MsgBox "fin todoexpertos"
End Sub

Hola Adriel, 

Muchas gracias por tu ayuda, pero no me funcionó :( , efectivamente se crearon las hojas nuevas, pero sin información, solo se agregó el nombre en ellas. También se creó una hoja adicional con solo los "Rut" de los clientes. Adjunto imagen... favor tu ayuda, para resolver.

Recuerda que la idea principal es dividir esta base en diferentes hojas, el dato clave es el Rut, pero tiene que traspasar a cada hoja todas las columnas referentes a ese "Rut"

Favor tu ayuda

Gracias :)

Al final de la página hay una opción para valorar esta respuesta como excelente u otros

Macro

Sub crearhoja()
    'Adriel doMangie
    '
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets.Add
    '
    Application.DisplayAlerts = False
    On Error Resume Next
    u = h1.Range("A" & Rows.Count).End(xlUp).Row
    u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
    h1.Range("A2:A" & u).Copy h2.Range("A1")
    h2.Range("$A$1:$A$" & u).RemoveDuplicates Columns:=1, Header:=xlNo
    '
    i = 1
    Do While h2.Cells(i, 1) <> ""
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = h2.Cells(i, 1)
        h1.Range("A1:P1").Copy ActiveSheet.Range("A1")
        i = i + 1
    Loop
    h2.Delete
    Application.DisplayAlerts = True
    MsgBox "fin todoexpertos"
End Sub

Hola, 

Gracias por tu pronta respuesta, ahora tenemos los encabezados en cada hoja, pero nos falta toda la información, te pido disculpa si me he expresado mal.

Respecto a la evaluación no lo dudes, necesito mucho este procedimiento así que te evaluaré super!!

Dame una pista con imágenes como debe de quedar porque hay datos duplicados en la hoja principal

OK, el unico campo llave es la columna A (Rut), todo lo que se repita en esa columna debe ser copiado en una hoja que contenga su información. 

Ejemplo, esta es la hoja base

Como ejemplo te adjunto imágenes de la primera y la segunda hoja que se debería generar con la información referente al primer  y segundo Rut. Así sucesivamente para el resto de los Rut de la columna A de la hoja 1.

Quedo atento, muchas gracias

Iván

Otro ejemplo,

Hoja (Hoja 1),

            Filas A1 (Rut)

            Filas A2:A10 (1234)

             Filas A11:A100 (3234)

             Filas A101:A151 (2345)

             Filas A152:A252 (2983)

            Columnas A1:N2 (Encabezados filas)

            Columnas B1:N142 (Datos cada Cliente)

El procedimiento debería crear las siguientes hojas

Hoja (1234)

                   Columnas A1:N1 (Encabezados filas), los mismos Hoja 1

                   Rango B2:N10 (Datos Cliente 1234) Extraídos de Hoja 1

Hoja (3234)

                    Columnas A1:N1 (Encabezados filas), los mismos Hoja 1

                    Rango B2:N89 (Datos Cliente 1234) Extraídos de Hoja 1

Hoja (2345)

                    Columnas A1:N1 (Encabezados filas), los mismos Hoja 1

                     Rango B2:N50 (Datos Cliente 1234) Extraídos de Hoja 1

Hoja (2983)

                    Columnas A1:N1 (Encabezados filas), los mismos Hoja 1

                     Rango B2:N100 (Datos Cliente 1234) Extraídos de Hoja 1

Así parece que esta un poco más claro.

Gracias

Macro actualizada

Sub crearhoja()
    'Adriel DoMangie
    '
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets.Add
    '
    Application.DisplayAlerts = False
    On Error Resume Next
    u = h1.Range("A" & Rows.Count).End(xlUp).Row
    u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
    h1.Range("A2:A" & u).Copy h2.Range("A1")
    h2.Range("$A$1:$A$" & u).RemoveDuplicates Columns:=1, Header:=xlNo
    '
    i = 1
    Do While h2.Cells(i, 1) <> ""
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = h2.Cells(i, 1)
        h1.Range("A1:P1").Copy ActiveSheet.Range("A1")
        x = 2
        For j = 1 To u
            Set b = h1.Cells(j, 1).Find(h2.Cells(i, 1), lookat:=xlWhole)
            If Not b Is Nothing Then
                h1.Rows(b.Row).Copy ActiveSheet.Range("A" & x)
                x = x + 1
            End If
        Next j
        i = i + 1
    Loop
    h2.Delete
    Application.DisplayAlerts = True
    MsgBox "fin todoexpertos"
End Sub

Hola, Yo nuevamente...

Te tengo buenas y malas noticias... La buena que el procedimiento funcionó en una tabla de 100 líneas aproximadamente.. pero después lo probé en el archivo original y lleva más de 10 minutos y pasa nada... no sé si seguir esperando... o se quedo en un bucle... mire las imágenes adjuntas... ¿qué puedo hacer?.

De antemano muchas gracias

Iván

Se quedo pegado... :(

Envíame tu archivo [email protected] para hacer pruebas

Correo enviado, Gracias

Hola, buenos días

¿Recibiste el archivo?

Gracias

[hola si recibí el archivo, tengo que modificar la macro te aviso.

Macro actualizada

El proceso me duró casi 4 min ya dependerá del rendimiento de tu equipo.

Puse una instrucción para que puedas ver el proceso en la barra de estado, te recomiendo que a la macro le asignes un botón y ejecutas

Sub crearhoja()
    'Adriel DoMangie
    '
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets.Add
    '
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    x = Time
    On Error Resume Next
    u = h1.Range("A" & Rows.Count).End(xlUp).Row
    u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
    h1.Range("A2:A" & u).Copy h2.Range("A1")
    h2.Range("$A$1:$A$" & u).RemoveDuplicates Columns:=1, Header:=xlNo
    '
    i = 1
    Do While h2.Cells(i, 1) <> ""
    Application.StatusBar = "Procesando: " & h2.Cells(i, 1)
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = h2.Cells(i, 1)
        x = 2
            If h1.AutoFilterMode Then h1.AutoFilterMode = False
            h1.Range("A1:P" & u).AutoFilter Field:=1, Criteria1:=h2.Cells(i, "A")
            h1.Range("A1:P" & u).Copy ActiveSheet.Range("A" & x)
            x = x + 1
            i = i + 1
    Loop
    y = Time
    Application.CutCopyMode = False
    Application.StatusBar = False
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    h2.Delete
    Application.ScreenUpdating = True
    MsgBox "fin, duración " & x - y
End Sub

Perfecto me funciono de maravillas, súper bien, me aliviará mucho trabajo. Muchas gracias.

Solo tengo dos puntos, que obvio son estéticos, pero obvio que para ti es mas fácil solucionarlos.

• El mensaje del formato al final no es correcto
• La primera fila queda vacía para todos los archivos generados (encabezados en fila 2), hoja base tiene los encabezados en la fila 1

Por ultimo, si quiera agregarle una macro grabada en donde le vaya dando formato a cada una de las hojas generadas, se que podría tardarse una eternidad, por eso haré pruebas, ¿En que lugar de la macro que me enviaste debería agregar este proceso que grabe?

Quedo atento muchas gracias

Iván