Dividir tabla excel en varios libros y varias hojas

Estoy complicado con una tabla de datos en excel que tengo intención de dividir. Paso a detallarte como tengo ordenados los datos y qué es lo que quiero lograr

Tengo mi tabla con los siguientes campos

Region

Canvenio

Especialidad

Matricula

Nombre

Fecha

Nombre est

Documento

Diag

Descripcion

De esta tabla me interesa poder dividir los datos en varios libros y varias hojas, teniendo en cuenta los campos convenio, nombre y fecha. La idea sería la siguiente: extraer los datos de los diferentes convenios en libros separados, y a su vez que en cada libro se genere una hoja de acuerdo a los nombres que integran ese convenio, finalmente en cada una de esas hojas se peguen 10 filas al azar teniendo en cuenta un rango de fechas.

1 Respuesta

Respuesta
1

Haber si entendí bien.

Si en tu tabla de datos tienes 50 líneas con esto:

Convenio = "c12"

Nombre = "Dam"

Fechas = esas 50 líneas

15 líneas tienen 5 de feb

15 líneas tienen 6 de feb y

20 líneas tienen 7 de feb

Y tu quieres que el rango de fechas sea del 5 de feb al 6 feb.

Entonces quieres que de 50 líneas se tomen solamente las líneas que están dentro del rango de fechas del 5 al 6 de feb, entonces tenemos 30 líneas, ¿correcto?

Ahora, ¿de esas 30 líneas quieres que se tomen 10 líneas al azar y se pongan en un libro llamado "c12" en la hoja llamada "Dam"?

'

Hola! Gracias por la respuesta.

Pero la cuestión es un poco más complicada, porque (siguiendo tu ejemplo) estarían los convenios c12, c13 y c14, y para cada convenio habría más de un nombre o sea en el convenio c12 estaría Dam1, Dam2, Dam3; en el c13 Dem1, Dem2, Dem3; y en c14 Dim1, Dim2 y Dim3. El resto, respecto a las fechas, es tal cual vos lo planteás.

Espero haber sido claro.

Agradezco nuevamente tu tiempo.

Saludos!

No planteé bien duda.

Ya sé que tienes varios convenios y que en cada convenio tienes varios nombres, eso está claro.

Regresando a mi ejemplo, suponiendo que solamente tienes un convenio "C12" y en ese convenio tienes solamente un nombre "dam", y con esos datos tienes 50 registros. Qué es lo que necesitas que haga la macro:

Puedes terminar este ejemplo, si puedes poner imágenes del resultado, o imágenes de cómo tienes tus datos y cómo quieres el resultado.

Pues bien, entonces (quedando claro lo de los convenios y los nombres) es tal cual como lo planteás en la primer respuesta: de los 30 resultados posibles que vos explicitás surgirían por las fecha, precisaría que, al azar, se eligieran 10. Es exactamente como vos lo ejemplificás.

Gracias de nuevo. Saludos!

Bien, ahora dime en cuáles columnas tienes cada dato: Convenio, nombre y fecha

El total de la tabla sigue las siguientes columnas

A - Región

B - convenio

C - especialidad

D - matricula

E - nombre

F - fecha

G - nombre est

H - fechanac (esta había olvidado ponerla pero no es relevante)

I - documento

J - diag

K - descripcion

Saludos!

Te anexo las macros:

Sub principal()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ruta = ThisWorkbook.Path
    '
    OrdenarDatos
    ConveniosNombres
    '
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    Set h3 = Sheets("Hoja3")
    Set h4 = Sheets("Hoja4")
    h3.Cells.Clear
    h4.Cells.Clear
    cant = h2.[D2]
    If cant = "" Then
        MsgBox "Falta el número de líneas a copiar"
        h2.Select
        [D2].Select
    End If
    '
    'títulos para filtrar
    h2.[J1] = h2.[A1]
    h2.[K1] = h2.[B1]
    h2.[L1] = h1.[F1]
    h2.[M1] = h1.[F1]
    '
    h2.Select
    h2.[l2] = ">=" & Evaluate("=CONCATENATE(F2)")
    h2.[M2] = ">=" & Evaluate("=CONCATENATE(G2)")
    '
    For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
        h2.[J2] = h2.Cells(i, "A")
        h2.[K2] = h2.Cells(i, "B")
        h1.[A1].CurrentRegion.AdvancedFilter xlFilterCopy, h2.[J1:M2], h3.[a1:K1]
        '
        fila = h3.Range("B" & Rows.Count).End(xlUp).Row
        If fila > cant + 1 Then
            h3.Rows(1).Copy h4.Rows(1)
            cont = 0
            j = 2
            Do While True
                y = Evaluate("=RANDBETWEEN(2," & fila & ")")
                If h3.Cells(y, "Z") = "" Then
                    h3.Rows(y).Copy h4.Rows(j)
                    h3.Cells(y, "Z") = "X"
                    j = j + 1
                    If j = cant + 1 Then Exit Do
                End If
            Loop
        Else
            h3.Cells.Copy h4.[A1]
        End If
        '
        libro = h4.[B2]
        archi = ruta & "\" & libro & ".xlsx"
        If Dir(archi) <> "" Then
            Set l2 = Workbooks.Open(archi)
            h4.Copy After:=l2.Sheets(l2.Sheets.Count)
            ActiveSheet.Name = h4.[E2]
            ActiveWorkbook.Save
            ActiveWorkbook.Close False
        Else
            h4.Copy
            ActiveSheet.Name = h4.[E2]
            ActiveWorkbook.SaveAs archi
            ActiveWorkbook.Close False
        End If
        '
    Next
    MsgBox "Proceso de crear libros, hojas y enviar registros aleatorios", vbInformation, "TERMINADO"
End Sub
'
Sub OrdenarDatos()
'Por.Dante Amor
    Set h1 = Sheets("Hoja1")
    u = h1.Range("B" & Rows.Count).End(xlUp).Row
    With h1.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("B2:B" & u) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("E2:E" & u) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("F2:F" & u) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1:K" & u)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
'
Sub ConveniosNombres()
'Por.Dante Amor
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    h2.Range("A:B").Clear
    u = h1.Range("B" & Rows.Count).End(xlUp).Row
    '
    h1.Range("B:B,E:E").Copy h2.Range("A1")
    h2.Range("A1:B" & u).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    '
End Sub

Te anexo el archivo que tiene la macro. Funciona de la siguiente manera:

En la hoja1 debes poner tus datos.

En la hoja2 en la celda D2 tienes que poner la cantidad de líneas a copiar.

En la hoja2 en las celdas F2 y G2 tienes que poner el rango de fechas, fecha inicial y fecha final.

En la hoja1 está un botón para que lo presiones y se generen los libros y las hojas.

No deben existir los libros, ya que se van a crear nuevos.

El archivo trabaja con las 4 hojas: hoja1, hoja2, hoja3 y hoja4. No las borres ni les cambies el nombre.

Te anexo el archivo con unos datos de prueba para que revises los resultados.

https://www.dropbox.com/s/3m1oehvbhkczsdn/convenio.xlsm?dl=0 


Saludos. Dante Amor

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas