Private Sub Worksheet_Activate()
Dim rng As Range
Dim lngDatum As Long
lngDatum = CLng(Date)
For Each rng In Range("B2:APP2")
If IsDate(rng) Then
If CLng(rng) = lngDatum Then
Application.Goto rng, True
Exit Sub
End If
End If
Next
End Sub
Private Sub Worksheet_Activate()
Dim rng As Range
Dim lngDatum As Long
lngDatum = CLng(Date)
For Each rng In Range("B2:APP2")
If IsDate(rng) Then
If CLng(rng) = lngDatum Then
Application.Goto rng, True
Exit Sub
End If
End If
Next
End Sub
Application.Goto rng.Offset(13, 0), True
Einfach die Goto-Zeile im Code ersetzen.Private Sub Worksheet_Activate()
Dim rng As Range
Dim lngDatum As Long
lngDatum = CLng(Date)
For Each rng In Range("B2:APP2") 'Bereich anpassen
If IsDate(rng) Then
If CLng(rng) = lngDatum Then
Application.Goto rng.Offset(13, 0), True
Exit Sub
End If
End If
Next
Set rng = Nothing
End Sub
Private Sub Worksheet_Activate()
Dim rng As Range
Dim lngDatum As Long
lngDatum = CLng(Date)
For Each rng In Range("B2:APP2") 'Bereich anpassen
If IsDate(rng) Then
If CLng(rng) = lngDatum Then
Application.Goto rng.Offset(12, 0), True
ActiveCell.Offset(1, 0).Select
Exit Sub
End If
End If
Next
Set rng = Nothing
End Sub
Gruß Matthias
With Range("B2:APP2")
If WorksheetFunction.CountIf(.Cells, CLng(Date)) = 0 Then Exit Sub
Application.Goto Cells(14, Application.Match(CLng(Date), .Cells, 0) + 1), 1
ActiveCell.Offset(1, 0).Select
End With
Na denn Gute N8Private Sub Worksheet_Activate()
With Range("B2:APP2")
If WorksheetFunction.CountIf(.Cells, CLng(Date)) = 0 Then Exit Sub
Cells(15, Application.Match(CLng(Date), .Cells, 0) + 1).Select
End With
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen