Segmentar archivo en diferentes libros

Tengo archivos en excel 2007 de alrededor de 500 000 registros pero para poder subirlos a una aplicación externa tengo que generar archivos de 10 000 registros c/u, me gustaría saber si me pueden ayudar con una macro que me automatice este proceso, separando los registros y guardando un archivo nuevo por cada 10 000 registros
Los archivos tienen 13 columnas y las filas van desde 100 000 a 500 000
De antemano muchas gracias
Saludos!

1 respuesta

Respuesta
1
No se si te he entendido bien, pero ahí va algo, con esta macro, divido las celdas en grupos de 10000 y creo un fichero (1) con ellas, con las otras 10000 creo otro fichero (2) y así sucesivamente.. Tendrías que cotejarlo, para ver que lo hace bien con tus registros y no se deja ninguno.
Private Sub CommandButton1_Click()
Dim c As Double
Dim r As Double
Dim a As Double
Dim n As Double
Dim x As Byte
Dim fichero As String
Dim nombrefichero As String
c = ActiveCell.SpecialCells(xlLastCell).Column
r = ActiveCell.SpecialCells(xlLastCell).Row
t = Int((c * r) / 10000) + 1
a = Int(r / t) + 1
n = 1
nombrefichero = InputBox("Como se llama el fichero a segmentar")
For x = 1 To t
Range(Cells(n, 1), Cells(a + n - 1, c)).Select
n = a * x + 1
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
fichero = nombrefichero & x & ".xls"
ActiveWorkbook.SaveAs Filename:=fichero, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
Next x
Range("a1").Select
End
End Sub
Hola cadipas, ¿muchas gracias por la pronta respuesta y ha sido de gran ayuda
la macro es funcional el detalle es que me segmenta los archivos en rangos de 666 filas
le modifique la siguiente linea
t = Int((c * r) / 10000) + 1
a
t = Int((c * r) / 155000) + 1
y ya me realizo la segementacion en archivos de 10 087 filas
la modificación que realice es correcta?
Gracias!
Como te entendí mal, pensaba que querías exportar 10000 celdas (registros), pero ahora veo que quieres 10000 filas, y para ello se simplifica algo, ahí va lo modificado
Private Sub CommandButton1_Click()
Dim r As Double, n As Double, n As Double, x As Double
Dim rango As String, fichero As String
r = ActiveCell.SpecialCells(xlLastCell).Row
n = 1
x = 0
nombrefichero = InputBox("Como se llama el fichero a segmentar")
Do While n < r
rango = n & ":" & n + 10000 - 1
Rows(rango).Select
n = n + 10000
x = x + 1
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
fichero = nombrefichero & x & ".xls"
ActiveWorkbook.SaveAs Filename:=fichero, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
Loop
Range("a1").Select
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas