AW: Geburtstag herausfinden
23.01.2013 12:55:06
UweD
Hallo
das ginge so:
Sub Geburtstage()
On Error GoTo Fehler
Dim TB1, TB2, i%
Dim SP%, LR&
Set TB1 = Sheets("Daten")
Set TB2 = Sheets("Geburtstage")
If TB1.AutoFilterMode Then TB1.AutoFilterMode = False ' Autofilter ausschalten
SP = 1 'Spalte A
LR = TB1.Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
Application.ScreenUpdating = False
TB1.Range("$K$1:$K$" & LR).AutoFilter Field:=1, Criteria1:="=" & Format(Date, "ddmm") & "*"
TB2.Cells.Clear
TB1.Cells.Copy TB2.Cells(1, 1)
TB1.AutoFilterMode = False ' Autofilter ausschalten
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
Problem ist die Art der Datumsdarstellung.
Die habe ich auf Text und 6stellig geändert.
hättest du richtige Daten (also mit 4 stelliger Jahreszahl), dann könntest du sogar noch ganz einfach den xten Geburtstag ausweisen.
Gruß UweD