Macro ile doğum günü takibi

[sadosit]

Merhaba,

400 kisinin doğum günü tarihini takip etmek istiyorum. Ekteki excel dosyasindan gorulecegi uzere uzun ve zahmetli yoldan manual olarak doğum tarihi olan personelleri görebiliyorum.

Ancak mümkün olabilir ise 2. sayfada bir buton ve macro yardımı ile bu 400 kişinin gelmesini sağlayabilir miyiz. Yani butono bastigim zaman var ise o gün doğum tarihi olan kişiler ekrana gelebilir mi.

Yoksa data/filter'dan bulmam soz konusu ancak cok kullanisli değil.

Teşekkür ederim, şimdiden

 

[asi_kral]

Merhaba
Kod olarak bunu kullanabilirsiniz.

Option Explicit
Sub doğum_1967()
Dim SAT As Long, SAY As Long
Dim S1 As Worksheet, S2 As Worksheet
Set S1 = Sheets("Sheet1"): Set S2 = Sheets("Sheet2")
Application.ScreenUpdating = False
S2.Range("A:A").ClearContents
SAY = 1
For SAT = 2 To S1.Cells(Rows.Count, "B").End(xlUp).Row
If DateSerial(Year(Date), Month(S1.Cells(SAT, "B")), _
Day(S1.Cells(SAT, "B"))) = Date Then
S2.Cells(SAY, "A") = S1.Cells(SAT, "A").Value
SAY = SAY + 1
End If: Next
Application.ScreenUpdating = True
MsgBox "Bugün Doğum Günü Olan " & SAY - 1 & " Kişi Var", vbInformation
End Sub

 

[Murat OSMA]

Şu iki kodu da bir deneyiniz;

 Sub Emre()
    Dim evn As Range
    Columns("K:S").Clear
    For Each evn In Range("B4:B" & Range("B65536").End(3).Row)
        If Left(evn.Value, 5) = Left(VBA.Date, 5) Then
            Range("A1:I1").Copy Range("K1")
            Cells(evn.Row, 1).Resize(, 9).Copy
            Range("K65536").End(3)(2, 1).PasteSpecial xlValues
        End If
    Next evn
    Application.CutCopyMode = False
    Columns.AutoFit
    Set evn = Nothing
End Sub

 Sub Emre()
    Dim evn As Integer
    Columns("K:S").Clear
    For i = 2 To Range("B65536").End(3).Row
        If Left(Cells(i, "B"), 5) = Left(VBA.Date, 5) Then
            Range("A1:I1").Copy Range("K1")
            Cells(i, 1).Resize(, 9).Copy
            Range("K65536").End(3)(2, 1).PasteSpecial xlValues
        End If
    Next i
    Application.CutCopyMode = False
    Columns.AutoFit
    evn = Empty
End Sub

 

[Murat OSMA]

Afedersiniz Sn. asi_kral_1967 mesajınızı görmedim.

 

[sadosit]

Değerli yorumlarınız icin tesekkur ederim.

 

[asi_kral]

Afedersiniz Sn. asi_kral_1967 mesajınızı görmedim.

Hiç önemi yok kolay gelsin.

Değerli yorumlarınız icin tesekkur ederim.

Kolay Gelsin.