Te anexo la macro con una opción para distribuir los registros en 10 tablas.
Sub DistribuirEnTablas()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h2 = Sheets("Hoja2")
Set h3 = Sheets("Hoja3")
h3.Cells.Clear
h2.Range("A:B").Copy h3.[AM1]
u = h3.Range("AM" & Rows.Count).End(xlUp).Row
With h3.Sort
.SortFields.Clear
.SortFields.Add Key:=h3.Range("AN2:AN" & u), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange h3.Range("AM1:AN" & u)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
i = 2
f = 101
m = 1
For j = 1 To 4
For k = 1 To 20 Step 2
h3.Cells(i, "AM").Copy h3.Cells(m, k)
h3.Cells(i, "AN").Copy h3.Cells(m, k + 1)
h3.Cells(f, "AM").Copy h3.Cells(m + 1, k)
h3.Cells(f, "AN").Copy h3.Cells(m + 1, k + 1)
i = i + 1
f = f - 1
Next
m = m + 2
Next
For k = 19 To 1 Step -2
h3.Cells(i, "AM").Copy h3.Cells(m, k)
h3.Cells(i, "AN").Copy h3.Cells(m, k + 1)
h3.Cells(f, "AM").Copy h3.Cells(m + 1, k)
h3.Cells(f, "AN").Copy h3.Cells(m + 1, k + 1)
i = i + 1
f = f - 1
Next
'
h2.Range("A1:B1").Copy
h3.Range("A1:T1").Insert Shift:=xlDown
Application.CutCopyMode = False
h3.Select
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "Distribución terminada"
End Sub
Para que funcione la macro deberás poner tus datos en la "Hoja2" como se muestra en la siguiente imagen:
El resultado de la macro aparecerá en la "Hoja3", como se muestra en la siguiente imagen:
Como puedes ver, tendrás 20 columnas, 2 columnas una para el ID y otra con sus correspondientes Unidades, ejemplo: la columna A y B es una tabla con 10 ID, la columna C y D es otra tabla con 10 ID.
Sigue las Instrucciones para ejecutar la macro
- Abre tu archivo de excel
- Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
- En el menú elige Insertar / Módulo
- En el panel del lado derecho copia la macro
- Para ejecutarla presiona F5