zum Datum Scrollen

Sub datum_scrollen()
If ActiveSheet.Name = "Tabelle1" Then
CenterOnCell Columns(2).Find(Date)
End If
End Sub

Sub CenterOnCell(OnCell As Range)
Dim VisRows As Integer
Dim VisCols As Integer
Application.ScreenUpdating = False
OnCell.Parent.Parent.Activate
OnCell.Parent.Activate
With ActiveWindow.VisibleRange
VisRows = .Rows.Count
VisCols = .Columns.Count
End With
With Application
.Goto reference:=OnCell.Parent.Cells( _
.WorksheetFunction.Max(1, OnCell.Row + _
(OnCell.Rows.Count / 2) - (VisRows / 2)), _
.WorksheetFunction.Max(1, OnCell.Column + _
(OnCell.Columns.Count / 2) - _
.WorksheetFunction.RoundDown((VisCols / 2), 0))), _
scroll:=True
End With
OnCell.Select
Application.ScreenUpdating = True
End Sub