Macro para Quitar tabla, ordenar por Rango e insertar Tabla
Tengo este problema que no he podido solucionar.
Tengo 6 tablas distintas (que no puedo ordenar en conjunto) y tengo un userform que va ingresando datos al final de cada tabla, ahora necesito un macro que me pase de tabla a rango en la 6 tablas y me seleccione todo el rango, los ordene bajo la columna A, y después me vuelva a insertar las 6 tablas.
2 respuestas
Prueba esta macro, recorre las hojas del libro, busca las tablas y las ordena por orden descendente en la columna A, solo adáptala a tus necesidades.
Sub ordena_tablas() Dim tbl As ListObject For Each nhoja In Worksheets Set h1 = Worksheets(nhoja.Name) For Each tbl In Worksheets(nhoja.Name).ListObjects ntbl = tbl.Name Set tabla = Range(ntbl) With tabla .Sort key1:=h1.Range(.Columns(1).Address), order1:=xlDescending, Header:=True End With Next Next End Sub
Hol.a
No queda lo suficientemente claro tu problema. Cuando dices "Tabla" asumo que usaste la herramienta "Tabla" de Excel ¿cierto? ¿Las seis están en a misma hoja? ¿Están en columnas colindantes o separadas? ¿Por qué quieres convertirlas en rango, solo para ordenarlas a la vez?
Quizá sea más fácil entender si vemos tu hoja aunque sea en imagen.
Abraham Valencia
Si son hechas en herramientas "tablas". Están en la misma hoja. Las quiero convertir a rango porque quiero que se ordenen en función a la columna A todas la demás columnas, y como tengo tablas adicionales no me deja ordenar como puedes ver la imagen
Entonces, de lo que se ve en la imagen, todas esas tablas están contiguas y a pesar de ser distintas quieres ordenar todas en base a la columna "A", entonces, algo así te será útil:
Sub OrdenaryTablas()
Dim TblRangos(5) As String, TblNombres(5) As String
Dim hoja As Worksheet, x As Integer, MiRango As Range
Dim Tablas As ListObject
Set hoja = Worksheets("Hoja5")
'Guardamos el rango y nombre de cada tabla
For x = 1 To 6
Let TblNombres(x - 1) = hoja.ListObjects(x).Name
Let TblRangos(x - 1) = Application.WorksheetFunction.Replace(hoja.ListObjects(x).DataBodyRange.Address, 4, 1, "2")
Next x
'Convertimos en rango todas las tablas
For Each Tablas In hoja.ListObjects
Tablas.Unlist
Next
Set MiRango = hoja.Range("A2").CurrentRegion
'Ordenamos todo en base a la columna A
With MiRango
.Sort key1:=hoja.Range("A2"), order1:=xlAscending, Header:=True
End With
'Copnvertimos en Tablas con los mismos nombres y rangos
For x = 1 To 6
hoja.ListObjects.Add(xlSrcRange, Range(TblRangos(x - 1)), , xlYes).Name = TblNombres(x - 1)
Next x
End SubOJO, estoy suponiendo que siempre serán seis tablas que los encabezados están en la fila 2. No olvides reemplazar el nombre de la hoja.
Abraham Valencia
PD: No entiendo eso de tener todo como seis tablas en lugar de una sola
Sabes que me resulto perfecto para 6 tablas. Ahora mi macro definitiva tiene 7 (te pido disculpas), ¿lo podrías cambiar? Porque ahora me da error.
Gracias
Y otra cosa la macro se activa desde otra hoja, por eso me da un error también, pero no me da error desde la hoja donde están las tablas. Qiusiera cambar eso también.
Gracias por tu paciencia.
La verdad es que tu caso me pareció interesante así que no te preocupes por la paciencia.
Mira, esto de acá se adapta a la cantidad de tablas de la hoja, 4, 5, 6, las que haya y además se puede "correr" desde cualquier hoja solo debes cambiar el nombre de la hoja y colocar la tuya en esta línea:
Set hoja = Worksheets("Hoja5")
Y esta es la macro:
Sub OrdenaryTablas()
Dim TblRangos() As String, TblNombres() As String
Dim hoja As Worksheet, MiRango As Range
Dim Tablas As ListObject
Dim MiIndice As Integer, x As Integer
Set hoja = Worksheets("Hoja5")
Let MiIndice = hoja.ListObjects.Count
ReDim TblRangos(MiIndice - 1) As String
ReDim TblNombres(MiIndice - 1) As String
'Guardamos el rango y nombre de cada tabla
For x = 1 To MiIndice
Let TblNombres(x - 1) = hoja.ListObjects(x).Name
Let TblRangos(x - 1) = Application.WorksheetFunction.Replace(hoja.ListObjects(x).DataBodyRange.Address, 4, 1, "2")
Next x
'Convertimos en rango todas las tablas
For Each Tablas In hoja.ListObjects
Tablas.Unlist
Next
Set MiRango = hoja.Range("A2").CurrentRegion
'Ordenamos todo en base a la columna A
With MiRango
.Sort key1:=hoja.Range("A2"), order1:=xlAscending, Header:=True
End With
'Copnvertimos en Tablas con los mismos nombres y rangos
For x = 1 To MiIndice
hoja.ListObjects.Add(xlSrcRange, hoja.Range(TblRangos(x - 1)), , xlYes).Name = TblNombres(x - 1)
Next x
End SubSalu2
Abraham Valencia