Dividir registros segun x cantidad y crear libros segun la cantidad de divisiones.
Publicado por Miguel (14 intervenciones) el 04/04/2022 22:15:04
Buenas estimados!,
Tengo un problemita con una macro...
Contexto: Tengo un archivo con 255mil registros en una columna, los cuales quiero dividir en varios libros, la division será cada 3mil registros. Entonces cada vez que el conteo de filas llega a 3mil, se copian y pegan en un nuevo libro. Así hasta culminar, la macro que encontré hace lo que describí pero los pega en una nueva hoja, no libro.
Es para una carga a una base de datos, por eso necesito que sean libros y no hojas las divisiones.
Dejo el código y el archivo con los 255mil registros, no entiendo mucho de VBA por eso solicito la ayuda, gracias por su tiempo...
Tengo un problemita con una macro...
Contexto: Tengo un archivo con 255mil registros en una columna, los cuales quiero dividir en varios libros, la division será cada 3mil registros. Entonces cada vez que el conteo de filas llega a 3mil, se copian y pegan en un nuevo libro. Así hasta culminar, la macro que encontré hace lo que describí pero los pega en una nueva hoja, no libro.
Es para una carga a una base de datos, por eso necesito que sean libros y no hojas las divisiones.
Dejo el código y el archivo con los 255mil registros, no entiendo mucho de VBA por eso solicito la ayuda, gracias por su tiempo...
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub SplitData()
Dim WorkRng As Range
Dim xRow As Range
Dim SplitRow As Integer
Dim xWs As Worksheet
On Error Resume Next
xTitleId = "Configuración"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
SplitRow = Application.InputBox("Split Row Num", xTitleId, 5, Type:=1)
Set xWs = WorkRng.Parent
Set xRow = WorkRng.Rows(1)
Application.ScreenUpdating = False
For i = 1 To WorkRng.Rows.Count Step SplitRow
resizeCount = SplitRowIf (WorkRng.Rows.Count - xRow.Row + 1) < SplitRow Then resizeCount = WorkRng.Rows.Count - xRow.Row + 1
xRow.Resize(resizeCount).Copy
Application.Worksheets.Add after:=Application.Worksheets(Application.Worksheets.Count)
Application.ActiveSheet.Range("A1").PasteSpecial
Set xRow = xRow.Offset(SplitRow)
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Valora esta pregunta
0
