¿Cómo elaborar una macro que copie los datos a de una hoja a otra de acuerdo a dos criterios (FechaInicial y FechaFinal)

En esta oportunidad necesito que me ayudes a elaborar una macro que extraiga los datos que contien una línea qué como indicativo de búsqueda posee una fecha, pero los datos a extraer son los que posea la fecha inmediato anterior a la fecha inicial... Acá te dejo un ejemplo censillo a partir de una macro que proporcionaste y en el cual describo lo que necesito.

Lo que quisiera es encontrar una forma que la macro recoja el primer valor Inmediato anterior a la fecha inicial, es decir la fecha que está arriba de la fecha Inicio así como se ve en la primer imagen en relleno color verde y la pegue en la hoja Resumen en el rango que se le indique.

Actualmente la macro hace esto: Sí copia los datos comprendidos entre las dos fechas, pero a la hora de pegar los datos que corresponden a la fecha anterior a la de inicio, éste pega el de la primera fecha que encuentra de arriba hacia abajo.

Lo que se necesita es que peque los datos de la primera fecha, pero el recorrido sería de abajo hacia arriba o como sea, pero que la fecha sea la inmediato anterior a la fecha inicio es decir la primer fecha que está arriba de la fecha inicio.

Te dejo los códigos utilizados, mismos que proporcionaste

Private Sub btnConsulta_Click()
Sheets("Resumen").Activate
Set H1 = Sheets("Ventas")
Set H2 = Sheets("Resumen")

H2.Range("C3:F" & Rows.Count).ClearContents
Fecha1 = H1.[K8]
Fecha2 = H1.[K9]

j = 3
n = 0
For i = 10 To H1.Range("C" & Rows.Count).End(xlUp).Row
If H1.Cells(i, "C") >= Fecha1 And H1.Cells(i, "C") <= Fecha2 Then
H1.Range("C" & i & ":F" & i).Copy
H2.Range("C" & j).PasteSpecial xlValues
j = j + 1
n = n + 1
End If
Next

Este es la parte de la macro que habría que modifcarle los códigos para que realice la acción indicada

FechaAnterior = Fecha1 - 1
H2.[F2] = ""
H2.[D2] = ""
For i = 1 To 4
Set b = H1.Columns("C").Find(FechaAnterior, lookat:=xlWhole)
If Not b Is Nothing Then

H2.[F2] = H1.Cells(b.Row, "F")
H2.[D2] = H1.Cells(b.Row, "C")
Exit For
Else
FechaAnterior = FechaAnterior - 1
End If
Next

End Sub

1 Respuesta

Respuesta
2

Hay que agregar el parámetro para que busque de abajo hacia arriba

SearchDirection:=xlPrevious

Te anexo la macro actualizada

Private Sub btnConsulta_Click()
'Act.Por.Dante Amor
    Sheets("Resumen").Activate
    Set H1 = Sheets("Ventas")
    Set H2 = Sheets("Resumen")
    H2.Range("C3:F" & Rows.Count).ClearContents
    Fecha1 = H1.[K8]
    Fecha2 = H1.[K9]
    j = 3
    n = 0
    For i = 10 To H1.Range("C" & Rows.Count).End(xlUp).Row
        If H1.Cells(i, "C") >= Fecha1 And H1.Cells(i, "C") <= Fecha2 Then
            H1.Range("C" & i & ":F" & i).Copy
            H2.Range("C" & j).PasteSpecial xlValues
            j = j + 1
            n = n + 1
        End If
    Next
    'Este es la parte de la macro que habría que modifcarle los códigos para que realice la acción indicada
    FechaAnterior = Fecha1 - 1
    H2.[F2] = ""
    H2.[D2] = ""
    For i = 1 To 4
        Set b = H1.Columns("C").Find(FechaAnterior, lookat:=xlWhole, SearchDirection:=xlPrevious)
        If Not b Is Nothing Then
            H2.[F2] = H1.Cells(b.Row, "F")
            H2.[D2] = H1.Cells(b.Row, "C")
            Exit For
        Else
            FechaAnterior = FechaAnterior - 1
        End If
    Next
    MsgBox "Fin"
End Sub

.

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

.

Avísame cualquier duda

.

La pregunta no admite más respuestas

Más respuestas relacionadas