Buscar fechas entre un rango de fechas y copiar la fila
Necesito ayuda con esta macro para Excel porque me resulta bastante compleja.
Tengo una hoja "Propuestas" en un libro1, y una hoja "Pendientes" en un libro2.
Desde el libro1 hoja "Propuestas" quiero definir un rango de fechas (periodo) con "fecha inicio" y "fecha fin", por ejemplo con un ImputBox.
Una vez que tenga ese rango de fechas, quiero ir al libro2, hoja "Pendientes" y buscar en la columna "F" todas las fechas que estén dentro de ese rango.
La hoja "Pendientes" puede tener unas 100000 filas.
Por último, quiero copiar esas filas (cuya fecha coincida), completas o bien desde la columna "A" a la "K", e ir a mi libro1 hoja "Propuestas" y pegarlas a continuación de las que ya tenga.
2 respuestas
H o l a:
Te anexo la macro para filtrar por fechas. Solamente tienes que completar algunos datos.
- En la macro cambia "Libro2.xlsx" por el nombre donde tienes tus datos
- Cambia el número 1 (uno) en la línea f = 1, por la fila donde tienes los encabezados de la hoja "Pendientes"
- Antes de ejecutar la macro debes tener abierto el "Libro2"
- Mencionaste que puedes tener 100,000 líneas, entonces preparé la macro con un filtro avanzado, para hacerlo más rápido, aún así, puede demorar según la memoria y el procesador que estés utilizando.
- La macro necesita de un rango de celdas para el filtro, en la macro puse las celdas N1 a Q2, puedes cambiarlo por otra rango, por ejemplo Z1 a AC2, siempre y cuando abarque 4 columnas y 2 filas. Avísame si quieres cambiar las celdas y tienes dificultades.
Sub Filtrar_Fechas()
'
' Por.Dante Amor
'
'
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Propuestas")
Set rango = h1.Range("N1:Q2") 'rango de celdas para el filtro
'
Set l2 = Workbooks("Libro2.xlsx") 'nombre del libro. Deberá estar abierto
Set h2 = l2.Sheets("Pendientes")
f = 1 'fila de encabezados
'
salir = True
Do While True
fecini = InputBox("Ingresa la fecha Inicial : ", "FILTRO FECHAS", "10/09/2017")
If fecini = "" Then Exit Sub
fecfin = InputBox("Ingresa la fecha Final : ", "FILTRO FECHAS", "10/09/2017")
If fecini = "" Then Exit Sub
'
If Not IsDate(fecini) Then
MsgBox "Captura fecha Inicial correcta"
Else
If Not IsDate(fecfin) Then
MsgBox "Captura fecha Final correcta"
Else
fec1 = CDate(fecini)
fec2 = CDate(fecfin)
If fec2 < fec1 Then
MsgBox "La fecha Final no puede ser menor a la fecha Desde"
Else
Exit Do
End If
End If
End If
Loop
'
Application.ScreenUpdating = False
'Poner datos para el filtro
rango.Cells(1, 1) = h2.Range("F1")
rango.Cells(1, 2) = h2.Range("F1")
rango.Cells(1, 3) = CDate(fec1)
rango.Cells(1, 4) = CDate(fec2)
rango.Cells(2, 1).Formula = "="">=""&R[-1]C[2]" 'pone fecha desde
rango.Cells(2, 2).Formula = "=""<=""&R[-1]C[2]" 'pone fecha hasta
'
'filtrar
If h2.FilterMode Then h2.ShowAllData
If h2.AutoFilterMode Then h2.AutoFilterMode = False
'
u1 = h1.Range("F" & Rows.Count).End(xlUp).Row + 1
u2 = h2.Range("F" & Rows.Count).End(xlUp).Row
h2.Range("A" & f & ":K" & u2).AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=h1.Range(rango.Address)
'
u2 = h2.Range("F" & Rows.Count).End(xlUp).Row
If u2 = f Then
MsgBox "No se encontraron registros"
Exit Sub
End If
h2.Range("A" & f + 1 & ":K" & u2).Copy h1.Range("A" & u1)
If h2.FilterMode Then h2.ShowAllData
Application.ScreenUpdating = True
MsgBox "Registros filtrados"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
¡Muchas gracias Dante! Es muy complicada para mí así que he de tomarme tiempo para estudiarla paso a paso, pero seguro que funcionara de maravilla como siempre. Si tengo alguna deuda te volveré a consultar, gracias de nuevo.👏👏👏
