Buscar en rango de fechas

Tengo una carpeta con varios archivos de excel, todos tienen varias hojas, pero específicamente voy a trabajar con una que se llama RUTA en todos los archivos, allí tiene dos oclumnas con fechas .Columna H(Fecha Inicial) columna I (Fecha final), deseo que la macro recorra todos los archivos y en un rango de fechas previamente digitado me devuelva el valor que se encuentre en la columna E de la fila donde estén esos rangos.

EJEMPLO:

COLUMNA E                            COLUMNA H                        COLUMNA I

VALOR 1                                    01/04/2018                         03/05/2018

VALOR 2                                    03/05/2018                         06/05/2018

Si yo coloco el rango finicial 01/01/2018  y final 31/06/2018 me deberia aparecer así:

COLUMNA A                                                                      COLUMNA B 

VALOR CELDA G4

(IGUAL EN TODOS LOS ARCHIVOS)                                  VALOR1

CELDA G4                                                                               VALOR2

Y así en todos los archivos que tengan valores en esos rangos.

2 respuestas

Respuesta
1

Prueba con la siguiente macro.

Ahora en las celdas C1 y D1 debes poner las fechas inicial y final de tu rango de fechas.

Cambia "C:\trabajo\", por la carpeta donde tienes tus archivos.

Sub Buscar_Regresar_Datos2()
'Por Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Hoja1")
    '
    fec1 = h1.Range("C1")       'fecha inicial
    fec2 = h1.Range("D1")       'fecha final
    carpeta = "C:\trabajo\"
    arch = Dir(carpeta & "*.xls*")
    fila = 3
    h1.Rows(fila & ":" & Rows.Count).ClearContents
    '
    Do While arch <> ""
        Set l2 = Workbooks.Open(carpeta & arch)
        For Each h In l2.Sheets
            If LCase(h.Name) = LCase("ruta") Then
                For i = 11 To h.Range("E" & Rows.Count).End(xlUp).Row
                    If h.Cells(i, "H").Value >= fec1 And h.Cells(i, "I").Value <= fec2 Then
                        h1.Cells(fila, "A").Value = h.Range("G4").Value
                        h1.Cells(fila, "B").Value = h.Range("E" & i).Value
                        h1.Cells(fila, "C").Value = h.Range("H" & i).Value
                        h1.Cells(fila, "D").Value = h.Range("I" & i).Value
                        fila = fila + 1
                    End If
                Next
                Exit For
            End If
        Next
        l2.Close False
        arch = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. 
'.[Avísame cualquier duda
Respuesta

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas