Macro buscar rangos mediante inputbox
Hola Mucho gusto
Lo que quiero realizar es una macro en la cual busque un rango de fechas mediante 2 inputbox, más o menos como una consulta en access, para hacerlo más claro quiero que en el 1er inputbox se coloque la fecha inicial a buscar y en el segundo la fecha final, para que busque el rango en la columna A de la hoja1 por así decirlo, al encontrarlo lo copie y lo pegue en otro libro nuevo.
Muchas gracias por tu ayuda
Lo que quiero realizar es una macro en la cual busque un rango de fechas mediante 2 inputbox, más o menos como una consulta en access, para hacerlo más claro quiero que en el 1er inputbox se coloque la fecha inicial a buscar y en el segundo la fecha final, para que busque el rango en la columna A de la hoja1 por así decirlo, al encontrarlo lo copie y lo pegue en otro libro nuevo.
Muchas gracias por tu ayuda
1 Respuesta
Respuesta de arico19
1
Te escribo el código. Aquí busca las fechas entre las celdas a1 y a10 y devuelve las más aproximadas por debajo de la inicial (la anterior) y de la final (también la anterior si la fecha introducida no existe en el rango. Después copia este rango en el libro prueba.xls situado en la carpeta principal del disco C, y que debe existir ya:
fechainit = InputBox("fecha inicio")
fechafint = InputBox("fecha fin")
Cells(20, 1).Value = fechainit
Cells(21, 1).Value = fechafint
Cells(22, 1).Formula = "=vlookup(a20, a1:a10, 1)"
Cells(23, 1).Formula = "=match(a22, a1:a10)"
Cells(24, 1).Formula = "=vlookup(a21, a1:a10, 1)"
Cells(25, 1).Formula = "=match(a24, a1:a10)"
Cells(26, 1).Value = "A" & Trim(Str(Cells(23, 1).Value)) & ":A" & Trim(Str(Cells(25, 1).Value))
Range(Cells(26, 1). Value). Copy
Workbooks. Open ("c:\prueba.xls")
Workbooks(2). Activate
ActiveSheet. Paste
fechainit = InputBox("fecha inicio")
fechafint = InputBox("fecha fin")
Cells(20, 1).Value = fechainit
Cells(21, 1).Value = fechafint
Cells(22, 1).Formula = "=vlookup(a20, a1:a10, 1)"
Cells(23, 1).Formula = "=match(a22, a1:a10)"
Cells(24, 1).Formula = "=vlookup(a21, a1:a10, 1)"
Cells(25, 1).Formula = "=match(a24, a1:a10)"
Cells(26, 1).Value = "A" & Trim(Str(Cells(23, 1).Value)) & ":A" & Trim(Str(Cells(25, 1).Value))
Range(Cells(26, 1). Value). Copy
Workbooks. Open ("c:\prueba.xls")
Workbooks(2). Activate
ActiveSheet. Paste
