Copiar en otra hoja los nombres de cumpleañeros y edad
Dante Amor, en Hoja1 de excel tengo :
A B C
1 nombres fecha nacim. direccion
2 Jorge Alvan 21/10/1980 xxxxxxx
3 Abel Siu 25/11/1975 yyyyyyy
4 etc
En Userform1 1 txthoy, 1 botón comando cmdcopiar
Lo que deseo es crear una macro para que me copie o filtre en Hojacumple sólo los nombres de las personas que cumplen años al día siguiente. Ejemplo sí hoy es 20/10/2016 al dar click en cmdcopiar me copie o filtre sólo al Sr. Jorge Alvan en la otra hoja Hojacumple .
2 Respuestas
Te propongo una solución sin necesidad de macros (es como yo lo resolvería)
El objetivo es crear una columna con el cálculo de la cantidad de días que faltan para el próximo cumpleaños y en otra columna la edad que cumplirá.
Te adjunto un ejemplo y para facilitarte la fórmula también te la adjunto la fórmula correspondiente a la celda E9:
=SI(FECHA(AÑO(C9)+ENTERO(($C$6-C9)/365);MES(C9);DIA(C9))<$C$6;FECHA(AÑO(C9)+ENTERO(($C$6-C9)/365)+1;MES(C9);DIA(C9));FECHA(AÑO(C9)+ENTERO(($C$6-C9)/365);MES(C9);DIA(C9)))-$C$6
Espero que te sea de utilidad y no olvides valorar la solución.
¡Gracias! La solución que planteas es buena, pero lamentablemente tengo una gran base de datos ( más de 1000 nombres)y sería tedioso fijarme en cada uno, lo que te planteo es que me filtre en otra hoja los que cumplirán años 1 día antes de la fecha actual como un aviso o alerta los cuales serían muy pocos y fácil de controlar, no sé sí puedas ayudarme en mi pedido.
Juan, te entiendo, por eso mismo verás que en la imagen adjunta la tabla tiene creada unos autofiltros de forma que puedes ordenar los registros por este campo o bien filtrar por cualquier valor. En la imagen adjunta he filtrado las personas a las que es su cumpleaños o bien les falta un día.
H o l a : Te anexo una macro, no es necesario el formulario, solamente asigna la macro a un botón. Cambia los nombres de las hojas en la macro por tus nombres.
Sub Cumple()
'Por.Dante Amor
Set h1 = Sheets("hoja1") 'hoja con nombres
Set h2 = Sheets("hojacumple") 'hoja con resultados
'
h2.Cells.Clear
h1.Rows(1).Copy h2.Rows(1)
j = 2
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
fec = h1.Cells(i, "B")
If fec = DateSerial(Year(fec), Month(Date), Day(Date) + 1) Then
h1.Rows(i).Copy h2.Rows(j)
j = j + 1
End If
Next
MsgBox "Fin"
End SubAhora si quieres la macro en el formulario y quieres escribir la fecha en un textbox, entonces tendría que ser así:
Private Sub CommandButton1_Click()
'Por.Dante Amor
Set h1 = Sheets("hoja1") 'hoja con nombres
Set h2 = Sheets("hojacumple") 'hoja con resultados
'
Dim fec2 As Date
If txthoy = "" Or Not IsDate(txthoy) Then
MsgBox "Captura una fecha válida"
Exit Sub
End If
fec2 = txthoy
h2.Cells.Clear
h1.Rows(1).Copy h2.Rows(1)
j = 2
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
fec = h1.Cells(i, "B")
If fec = DateSerial(Year(fec), Month(fec2), Day(fec2) + 1) Then
h1.Rows(i).Copy h2.Rows(j)
j = j + 1
End If
Next
MsgBox "Fin"
End SubCambiar los nombres de las hojas. En el textbox tienes que escribir la fecha que quieras consultar, por ejemplo, si pones 20/10/2016 (20 de octubre de 2016), la macro te escribirá en la hoja cumple el nombre de Jorge.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias