aktuelles Datum in Spalte finden

Sub AktuellesDatumFinden()
On Error GoTo Fehlermeldung
If InStr(ActiveSheet.Name, "Kalender " & Year(Date)) Then
Anfang:
Dim ws As Worksheet
Dim r As Range
Set ws = ActiveSheet
'Set r = Cells.Find(Date)   

Privat Sub SpinButton1_SpinDown()
'ausgewählter Name aus Listbox in Tabelle verschieben nach rechts
Application.ScreenUpdating = False
If ListBoxVorhandenePersonen.ListIndex = -1 Then
MsgBox "Bitte Mitarbeiter auswählen", vbCritical, "Kein Eintrag in Listbox ausgewählt..."
Exit Sub
End If
'Wenn der letzte Eintrag nach unten verschoben werden soll
If ListBoxVorhandenePersonen.ListIndex = ListBoxVorhandenePersonen.ListCount - 1 Then
MsgBox "Der aktuelle und letzte Eintrag: " & Chr(10) & Chr(10) & ListBoxVorhandenePersonen.  _
_
Value & Chr(10) & Chr(10) & " Kann nicht weiter nach unten verschoben werden!", vbCritical, " _
Kein Eintrag in Listbox ausgewählt..."
Exit Sub
End If
'Verschiebebereich definieren
Dim letzteSpalte As Long
Dim letzteZeile As Long
'Hier wird die letzte Spalte der Zeile 2 ermittelt
letzteSpalte = ActiveSheet.Cells(2, 48).End(xlToLeft).Column
letzteZeile = ActiveSheet.Cells(500, 2).End(xlUp).Row
'Suchwort festlegen
Dim NamenSpalte As Range
Dim NamensSpeicher As String
Dim rng As Range
With ActiveSheet.Range("D2:AU2")
Set rng = .Find(ListBoxVorhandenePersonen.Value, LookIn:=xlValues)
End With
NamensSpeicher = rng
If Not rng Is Nothing Then
' MsgBox rng.Column
' Cells(1, rng.Column).Select
'und Spalte markieren
Range(Cells(1, rng.Column), Cells(letzteZeile, rng.Column)).Select
'Spalte nach rechts verschieben
'Range(Cells(1, rng.Column), Cells(letzteZeile, rng.Column))
Dim vntReturn As Variant
vntReturn = rng.Column
Columns(vntReturn).Cut
Columns(ActiveCell.Column + 1).Select
Columns(ActiveCell.Column + 1).Insert Shift:=xlRight
End If
'Listbox aktualisieren
Call ListboxMitarbeiterAktualisieren
'verschobenen Namen wieder markeiren
ListBoxVorhandenePersonen.Value = NamensSpeicher
Set rng = Nothing
NamensSpeicher = ""
Application.ScreenUpdating = True
End Sub