Macro para ordenar alfabéticamente datos de varias hojas

Que macro puedo utilizar para que me orden alfabéticamente datos de 5 hojas.

Cuando hago una macro para ordenar me sale así:

Sub Macro2()
'
' Macro2 Macro
'

'
ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Add Key:=Range("A5"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Hoja1").Sort
.SetRange Range("A2:J")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

Pero sale solo para ordenar datos en Hoja1 y necesito que me ordene 5 hojas, que hay que cambiar. Además el rango de filas es indefinido, el de columnas va de la A hasta la J.

La idea es que cada vez que ingrese datos en cualquier hoja la macro me los ordene automáticamente conforme los vaya ingresando.

1 Respuesta

Respuesta
1

H o l a:

Te anexo la macro para ordenar  los datos en las 5 hojas

Sub Macro2()
'
    Application.ScreenUpdating = False
    hojas = Array("Hoja1", "Hoja2", "Hoja3", "Hoja4", "Hoja5")
    For i = LBound(hojas) To UBound(hojas)
        Set h = Worksheets(hojas(i))
        With h.Sort
            .SortFields.Clear
            .SortFields.Add Key:=h.Range("A1")
            .SetRange h.Range("A2:J" & h.Range("A" & Rows.Count).End(xlUp).Row)
            .Header = xlNo: .MatchCase = False: .Orientation = xlTopToBottom
            .SortMethod = xlPinYin: .Apply
        End With
    Next
    MsgBox "Terminado"
End Sub

Por otra parte, comentas: 

"La idea es que cada vez que ingrese datos en cualquier hoja la macro me los ordene automáticamente"

¿Cómo realizas el ingreso de datos?

¿Lo haces manualmente celda por celda?

Si es así no te recomiendo que se haga de forma automática, ya que en cuanto modifiques una celda la macro se activará y ordenará el registro que estás capturando.


Si aún así quieres que sea automáticamente, entonces pon la siguiente macro en los eventos de tu libro, los datos se ordenarán cada vez que pongas algo en la columna A de la hojas 1 a la 5

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Por.Dante Amor
    Application.ScreenUpdating = False
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Columns("A")) Is Nothing Then
        Select Case Sh.Name
            Case "Hoja1", "Hoja2", "Hoja3", "Hoja4", "Hoja5"
                With Sh.Sort
                    .SortFields.Clear: .SortFields.Add Key:=Sh.Range("A1")
                    .SetRange Sh.Range("A2:J" & Sh.Range("A" & Rows.Count).End(xlUp).Row)
                    .Header = xlNo: .MatchCase = False: .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin: .Apply
                End With
        End Select
        Application.ScreenUpdating = True
    End If
End Sub


Instrucciones para poner la macro en los eventos ThisWorkbook

  1. Abre tu libro de excel
  2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
  3. Del lado izquierdo dice: VBAProject, abajo dale doble click a ThisWorkbook
  4. En el panel del lado derecho copia la macro


' : )
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
' : )

Gracias por la ayuda,

El asunto es que tengo el formulario en ingreso los datos y al darle aceptar entonces se agregan los datos a la hoja, entonces ahí es donde quiero que los vaya agregando alfabéticamente. Cada hoja es independiente de la otra, o sea que pueda que no ingrese datos en las demás hojas, pero necesito que la macro ordenadora funcione en las 5 hojas porque cuando grabo una macro solo me da para ordenar una hoja. La idea es que al seleccionar una hoja la macro funcione también ahí.

Probé la primera macro y me sale error en

Set h = Worksheets(hojas(i))

Entonces pon lo siguiente después de agregar el registro a la hoja activa:

        Set h = activesheet
        With h.Sort
            .SortFields.Clear
            .SortFields.Add Key:=h.Range("A1")
            .SetRange h.Range("A2:J" & h.Range("A" & Rows.Count).End(xlUp).Row)
            .Header = xlNo: .MatchCase = False: .Orientation = xlTopToBottom
            .SortMethod = xlPinYin: .Apply
        End With

' : )
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
' : )

Fíjate me da error en

set h = activesheet

Lo que esta en negrita me lo marca

Esta es la macro que agrega los datos:

Option Explicit
Dim ArchivoIMG As String

Private Sub cmd_Agregar_Click()
Dim i As Integer
If cbo_Nombre.Text = "" Then
MsgBox "Nombre inválido", vbInformation + vbOKOnly
cbo_Nombre.SetFocus
Exit Sub
End If
If Not (Mid(cbo_Nombre.Text, 1, 1) Like "[a-z]" Or Mid(cbo_Nombre.Text, 1, 1) Like "[A-Z]") Then
MsgBox "Nombre inválido", vbInformation + vbOKOnly
cbo_Nombre.SetFocus
Exit Sub
End If
Dim fCliente As Integer
fCliente = nCliente(cbo_Nombre.Text)
'controlar que haya algún OB seleccionado
If OptionButton1.Value = False And OptionButton2.Value = False And OptionButton3.Value = False And OptionButton4.Value = False And OptionButton5.Value = False Then
MsgBox "Debes seleccionar algún botón de Cliente. Luego ejecuta nuevamente el botón de guardado.", , "ERROR"
Exit Sub
End If
'------------
If fCliente = 0 Then
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate ' si el registro no existe, se va al final.
Loop
Else
Cells(fCliente, 1).Select ' cuando ya existe el registro, cumple esta condición.
End If
'Aqui es cuando agregamos o modificamos el registro
Application.ScreenUpdating = False
ActiveCell = cbo_Nombre
ActiveCell.Offset(0, 1) = txt_numero
ActiveCell.Offset(0, 2) = txt_conteofisico
ActiveCell.Offset(0, 3) = txt_fechaven
ActiveCell.Offset(0, 4) = txt_numerolote
ActiveCell.Offset(0, 5) = txt_nukardex
ActiveCell.Offset(0, 6) = txt_fekardex
ActiveCell.Offset(0, 7) = txt_ultimosaldo
ActiveCell.Offset(0, 8) = txt_observaciones
ActiveCell.Offset(0, 9) = ArchivoIMG
Columns("J").EntireColumn.Hidden = True
Application.ScreenUpdating = True
LimpiarFormulario
cbo_Nombre.SetFocus

End Sub

Este código se usa para agregar datos a cualquiera de las 5 hojas

Pero necesito que se ordenen cada vez que agrego un dato

Quedaría así:

Option Explicit
Dim ArchivoIMG As String
Private Sub cmd_Agregar_Click()
Dim i As Integer
If cbo_Nombre.Text = "" Then
MsgBox "Nombre inválido", vbInformation + vbOKOnly
cbo_Nombre.SetFocus
Exit Sub
End If
If Not (Mid(cbo_Nombre.Text, 1, 1) Like "[a-z]" Or Mid(cbo_Nombre.Text, 1, 1) Like "[A-Z]") Then
MsgBox "Nombre inválido", vbInformation + vbOKOnly
cbo_Nombre.SetFocus
Exit Sub
End If
Dim fCliente As Integer
fCliente = nCliente(cbo_Nombre.Text)
'controlar que haya algún OB seleccionado
If OptionButton1.Value = False And OptionButton2.Value = False And OptionButton3.Value = False And OptionButton4.Value = False And OptionButton5.Value = False Then
MsgBox "Debes seleccionar algún botón de Cliente. Luego ejecuta nuevamente el botón de guardado.", , "ERROR"
Exit Sub
End If
'------------
If fCliente = 0 Then
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate ' si el registro no existe, se va al final.
Loop
Else
Cells(fCliente, 1).Select ' cuando ya existe el registro, cumple esta condición.
End If
'Aqui es cuando agregamos o modificamos el registro
Application.ScreenUpdating = False
ActiveCell = cbo_Nombre
ActiveCell.Offset(0, 1) = txt_numero
ActiveCell.Offset(0, 2) = txt_conteofisico
ActiveCell.Offset(0, 3) = txt_fechaven
ActiveCell.Offset(0, 4) = txt_numerolote
ActiveCell.Offset(0, 5) = txt_nukardex
ActiveCell.Offset(0, 6) = txt_fekardex
ActiveCell.Offset(0, 7) = txt_ultimosaldo
ActiveCell.Offset(0, 8) = txt_observaciones
ActiveCell.Offset(0, 9) = ArchivoIMG
Columns("J").EntireColumn.Hidden = True
'
'Ordenar hoja
'Por.Dante Amor
    Dim h
    Set h = ActiveSheet
        With h.Sort
            .SortFields.Clear
            .SortFields.Add Key:=h.Range("A1")
            .SetRange h.Range("A2:J" & h.Range("A" & Rows.Count).End(xlUp).Row)
            .Header = xlNo: .MatchCase = False: .Orientation = xlTopToBottom
            .SortMethod = xlPinYin: .Apply
        End With
'Fin ordenar hoja
Application.ScreenUpdating = True
LimpiarFormulario
cbo_Nombre.SetFocus
End Sub
' : )
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
' : )

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas