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
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)
