Macro que Guarda Datos de Hoja y a la ves ordena en forma ascendente según fecha

Para: Dante Amor

Ante todo un gran saludo a tu persona, tengo una macro que me diste y esta siendo de gran ayuda, pero tengo un inconveniente, como podría hacer que la macro me ordene según fechas en forma ascendente ya que en la hoja que estuve almacenando se encuentran desordenados Trate de resolver el problema con filtros pero sin resultados Gracias por la respuesta que me puedas dar.

La macro que tengo en el botón guardar es la siguiente:

Sub Guardar()
'Por.Dante
    Set h = Sheets("Base")
    Set h1 = ActiveSheet
    Set b = h.Columns("B").Find(h1.Name, lookat:=xlWhole)
    If Not b Is Nothing Then
        res = MsgBox("Estos Datos ya existen, Desea cambiarla?", vbYesNo + vbExclamation, "")
        If res = vbYes Then
            h.Cells(b.Row, "C") = h1.[L6]
            h.Cells(b.Row, "D") = h1.[N7]
            h.Cells(b.Row, "E") = h1.[P7]
            h.Cells(b.Row, "F") = h1.[R7]
            h.Cells(b.Row, "G") = h1.[L11]
            h.Cells(b.Row, "H") = h1.[N12]
            h.Cells(b.Row, "I") = h1.[P12]
            h.Cells(b.Row, "J") = h1.[R12]
            h.Cells(b.Row, "K") = h1.[L17]
            h.Cells(b.Row, "L") = h1.[J22]
            MsgBox "Fin del proceso", vbInformation, ""
        End If
    Else
        u = h.Range("B" & Rows.Count).End(xlUp).Row + 1
            h.Cells(u, "B") = h1.Name
            h.Cells(u, "C") = h1.[L6]
            h.Cells(u, "D") = h1.[N7]
            h.Cells(u, "E") = h1.[P7]
            h.Cells(u, "F") = h1.[R7]
            h.Cells(u, "G") = h1.[L11]
            h.Cells(u, "H") = h1.[N12]
            h.Cells(u, "I") = h1.[P12]
            h.Cells(u, "J") = h1.[R12]
            h.Cells(u, "K") = h1.[L17]
            h.Cells(u, "L") = h1.[J22]
            MsgBox "Se a guardado correctamente", vbInformation
    End If
End Sub

1 Respuesta

Respuesta
1

Prueba con la siguiente macro, cambia en esta parte de la macro la letra "M" por la letra de la última columna que tiene datos.

.SetRange h.Range("B2:M" & u)

Sub Guardar()
'Por.Dante
    Set h = Sheets("Base")
    Set h1 = ActiveSheet
    Set b = h.Columns("B").Find(h1.Name, lookat:=xlWhole)
    If Not b Is Nothing Then
        res = MsgBox("Estos Datos ya existen, Desea cambiarla?", vbYesNo + vbExclamation, "")
        If res = vbYes Then
            h.Cells(b.Row, "C") = h1.[L6]
            h.Cells(b.Row, "D") = h1.[N7]
            h.Cells(b.Row, "E") = h1.[P7]
            h.Cells(b.Row, "F") = h1.[R7]
            h.Cells(b.Row, "G") = h1.[L11]
            h.Cells(b.Row, "H") = h1.[N12]
            h.Cells(b.Row, "I") = h1.[P12]
            h.Cells(b.Row, "J") = h1.[R12]
            h.Cells(b.Row, "K") = h1.[L17]
            h.Cells(b.Row, "L") = h1.[J22]
            MsgBox "Fin del proceso", vbInformation, ""
        End If
    Else
        u = h.Range("B" & Rows.Count).End(xlUp).Row + 1
            h.Cells(u, "B") = h1.Name
            h.Cells(u, "C") = h1.[L6]
            h.Cells(u, "D") = h1.[N7]
            h.Cells(u, "E") = h1.[P7]
            h.Cells(u, "F") = h1.[R7]
            h.Cells(u, "G") = h1.[L11]
            h.Cells(u, "H") = h1.[N12]
            h.Cells(u, "I") = h1.[P12]
            h.Cells(u, "J") = h1.[R12]
            h.Cells(u, "K") = h1.[L17]
            h.Cells(u, "L") = h1.[J22]
            '
            With h.Sort
                .SortFields.Clear
                .SortFields.Add Key:=h.Range("B3:B" & u), _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SetRange h.Range("B2:M" & u)
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            '
            MsgBox "Se a guardado correctamente", vbInformation
    End If
End Sub

Hola! Dante

Gracias por la pronta y rápida respuesta te comento que con la macro que me indicas los encabezados los lleva asía abajo aparte que lo deja sombreado.

La parte donde indicas que cambie lo hice de esta manera.

 With h.Sort
                .SortFields.Clear
                .SortFields.Add Key:=h.Range("B3:B" & u), _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SetRange h.Range("B2:AQ" & u)
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            '

Espero no haberme equivocado gracias por la respuesta que me puedas dar.

Cual  podría ser el problema de la macro que me diste porque no pude resolverlo.

Cambia esto:

.SortFields.Add Key:=h.Range("B3:B" & u), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange h.Range("B2:M" & u)

Por esto

.SortFields.Add Key:=h.Range("B5:B" & u), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange h.Range("B4:M" & u)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas