|
Hola que tal, espero se encuentren bien, quisiera solicitar su ayuda.
Dentro de excel me han encargado hacer como una descomposicion de una tabla en varias tablas.
Yo he encontrado un codigo que hace eso, descompone una tabla mediante una condicion y crea nuevos libros a partir de esto.
Ahora o que yo solicita y si me pudieran ayudar es algo parecido a lo que he mencionado nada mas que es en lugar de crear nuevas con las tablas me cree las tablas debajo de la misma hoja.
Les dejo el codigo que encontre y espero me puedan ayudar.
Saludos y Gracias.
Codigo:
Sub Hoja_x_Depto()
Application.ScreenUpdating = False
Dim Celda As Range
With Worksheets("hoja1").Range("a2").CurrentRegion
.Parent.Range("e1,g1") = .Cells(1)
.Resize(, 1).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=.Parent.Range("g1"),
Unique:=True
.Parent.Range("g1").Sort _
Key1:=.Parent.Range("g2"), Order1:=xlAscending, Header:=True
With .Parent.Range("g1").CurrentRegion
For Each Celda In .Offset(1).Resize(.Rows.Count - 1)
.Parent.Range("e2") = Celda
With Worksheets.Add(After:=Worksheets(Worksheets.Count))
.Name = Celda
End With
.Parent.Range("a2").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=.Parent.Range("e1:e2"),
_
CopyToRange:=Range("a1:c1")
Next
End With
|