Saludos, necesito ayuda con excel

Hola que tal, espero se encuentren bien, quisiera solicitar su ayuda.
Dentro de excel me han encargado hacer como una descomposición de una tabla en varias tablas.
Yo he encontrado un código que hace eso, descompone una tabla mediante una condición 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 más que es en lugar de crear nuevas con las tablas me cree las tablas debajo de la misma hoja.
Les dejo el código que encontré y espero me puedan ayudar.
Saludos y Gracias.
Código:
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