Busca fecha en diferentes columnas y copia en otra hoja
Elsa Matilde : Agradezco por la ayuda
Tengo en Libro 1---> 2 hojas VENCIMIENTOS y VENCE:
En hoja VENCIMIENTOS ---> A: Nombre (texto) B:Vence1 C:Vence2 (fechas dd/mm/yyyy)
En hoja VENCE --->A : Nombre
En Useform1 2 optionbuttom : opt1 y opt2 y listbox1
Al hacer click en opt1 3 procedimientos :
Sub busca1() ' Busca y copia fecha solicitada en col B
Dim FV1 As Date
Sheets("VENCE").Range("A:K").Clear ' Borra datos anteriores
j = 2
For i = 2 To Sheets("VENCIMIENTOS").Range("B" & Rows.Count).End(xlUp).Row
FV1 = Sheets("VENCIMIENTOS").Cells(i, "B")
If FV1 = Format(Now , "dd/mm/yyyy") Then ' busca la fecha actual solicitada
Sheets("VENCIMIENTOS").Range("A" & i ).Copy Sheets("VENCE").Range("A" & j) 'copia
j = j + 1
End If
Next
End Sub
Sub busca2() ' Busca y copia fecha solicitada en col C
Dim FV2 As Date
j = 2
For i = 2 To Sheets("VENCIMIENTOS").Range("C" & Rows.Count).End(xlUp).Row
FV2 = Sheets("VENCIMIENTOS").Cells(i, "C")
If FV2 = Format(Now , "dd/mm/yyyy") Then
Sheets("VENCIMIENTOS").Range("A" & i ).Copy Sheets("VENCE").Range("A" & j + 5) 'baja 5 filas
j = j + 1
End If
Next
End Sub
Sub eliminaf() 'Elimina filas vacias de Hoja VENCE
Sheets("VENCE").Select
finrango = Range("A5000").End(xlUp).Row
Range("A2").Select
While ActiveCell.Row <= finrango
If ActiveCell.Value = "" Then
ActiveCell.EntireRow.Delete
finrango = finrango - 1
Else
ActiveCell.Offset(1, 0).Select
End If
Wend
End Sub
Y en Listbox 1 se muestra los datos de la Hoja VENCE (que cumplen la fecha solicitada en este caso Now.
Lo que deseo es hacerlo más simple con una macro y juntar estos proced. En uno sólo, ya que tengo 4 columnas de fechas y es más extenso, pensé al acabar la búsqueda y copiar de la 1ra. Col seleccionar la última fila vacía y realizar la búsqueda y copiar a partir de la ultima fila, agradeciendo de antemano por la ayuda . Utilizo Excel 2016.