extraer n datos de una columna y crear archivos

[pablomda]

Buen día a todos, soy principiante en el foro e intermedio en EXCEL, les cuento lo que necesito:

Tengo unas bases de datos que contienen una sola columna con unos 100.000 datos (todos numericos) y con esta columna tengo que crear n archivos de n cantidad de datos cada uno (por ejemplo ahora yo copio y pego de a 2.500 datos) alguien me puede guiar como puedo automatizar este proceso???

AHI DEJE EL ARCHIVO ADJUNTO DE EJEMPLO, LO TUVE QUE HACER RAR PORQUE NO LO PODIA SUBIR DE OTRA FORMA

saludos

Pablo

ejemplo 42k de datos.rar

[mjrofra]

Hola Pablo,

mientras subes un archivo de ejemplo, te dejo un primer borrador que quizás te ayude:

Sub Prueba()


   Const DATOS_POR_ARCHIVO As Long = [COLOR=#ff0000]2500[/COLOR]




   Dim lngTotalArchivos As Long

   Dim lngArchivo As Long

   Dim rngDatos As Excel.Range




   ' Ingresa acá el nombre de la hoja en la que se encuentran los datos y en qué columna

   Set rngDatos = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]").Range("[COLOR=#ff0000]a1[/COLOR]", Range("[COLOR=#ff0000]a[/COLOR]" & Rows.Count).End(xlUp))



   lngTotalArchivos = Application.RoundUp(rngDatos.Rows.Count / DATOS_POR_ARCHIVO, 0)




   Application.ScreenUpdating = False



   For lngArchivo = 1 To lngTotalArchivos



      Application.StatusBar = "Creando libro " & lngArchivo & " de " & lngTotalArchivos



      With Workbooks.Add(xlWBATWorksheet)


         Sheets(1).Range("a1:a" & DATOS_POR_ARCHIVO) = rngDatos.Offset(DATOS_POR_ARCHIVO * (lngArchivo - 1)).Resize(DATOS_POR_ARCHIVO).Value

         .Close True, Replace(ThisWorkbook.FullName, ".xl", "_RESUMEN_" & lngArchivo)


      End With


   Next lngArchivo



   Application.StatusBar = False

   Application.ScreenUpdating = True



   Set rngDatos = Nothing


End Sub[/CODE]

Cambia "[color=#ff0000]Sheet1[/color]" por el nombre de la hoja en la que tienes los datos. La macro asume que empiezan en "[color=#ff0000]a1[/color]" y todos están en la columna "[color=#ff0000]a[/color]".

[b]EDITO[/b]: La macro creará los archivos en la misma carpeta en la que tengas guardado el archivo del que ejecutas la macro y con el mismo nombre más el sufijo "_RESUMEN_[color=#0000FF]n[/color]", siendo [color=#0000FF]n[/color] el número de archivo.

[pablomda]

muchas gracias por la respuesta! ahi deje en el mensaje original el archivo adjunto en .rar porque no lo pude subir de otra forma

saludos y gracias de nuevo

Pablo

[pablomda]

MAURICIO MUCHAS GRACIAS POR ESTA MACRO, ANDA AL PELO.

Lo que te queria preguntar es como puedo hacer para que trabajando con 2007, los datos que sean creados por la macro se creen en formato 2003 *.xls, ya que las bases que uso son muy extensas y las trabajo en 2007 pero el programa por el que corro los fragmentos de estas bases me reconoce sólo .xls???

Gracias por tu tiempo y tu amabilidad

saludos

Pablo

Hola Pablo,

mientras subes un archivo de ejemplo, te dejo un primer borrador que quizás te ayude:

Sub Prueba()


   Const DATOS_POR_ARCHIVO As Long = [COLOR=#ff0000]2500[/COLOR]




   Dim lngTotalArchivos As Long

   Dim lngArchivo As Long

   Dim rngDatos As Excel.Range




   ' Ingresa acá el nombre de la hoja en la que se encuentran los datos y en qué columna

   Set rngDatos = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]").Range("[COLOR=#ff0000]a1[/COLOR]", Range("[COLOR=#ff0000]a[/COLOR]" & Rows.Count).End(xlUp))



   lngTotalArchivos = Application.RoundUp(rngDatos.Rows.Count / DATOS_POR_ARCHIVO, 0)




   Application.ScreenUpdating = False



   For lngArchivo = 1 To lngTotalArchivos



      Application.StatusBar = "Creando libro " & lngArchivo & " de " & lngTotalArchivos



      With Workbooks.Add(xlWBATWorksheet)


         Sheets(1).Range("a1:a" & DATOS_POR_ARCHIVO) = rngDatos.Offset(DATOS_POR_ARCHIVO * (lngArchivo - 1)).Resize(DATOS_POR_ARCHIVO).Value

         .Close True, Replace(ThisWorkbook.FullName, ".xl", "_RESUMEN_" & lngArchivo)


      End With


   Next lngArchivo



   Application.StatusBar = False

   Application.ScreenUpdating = True



   Set rngDatos = Nothing


End Sub[/CODE]

Cambia "[color=#ff0000]Sheet1[/color]" por el nombre de la hoja en la que tienes los datos. La macro asume que empiezan en "[color=#ff0000]a1[/color]" y todos están en la columna "[color=#ff0000]a[/color]".

[b]EDITO[/b]: La macro creará los archivos en la misma carpeta en la que tengas guardado el archivo del que ejecutas la macro y con el mismo nombre más el sufijo "_RESUMEN_[color=#0000FF]n[/color]", siendo [color=#0000FF]n[/color] el número de archivo.