Überprüfung von Datum mit anschliessendem Kopieren einer anderen Zelle

[Primo Centurio]

Hallo miteinander

Ich habe den ganzen Morgen damit verbracht mit den Forenbeiträgen eine gesamt Formel zu erstellen. Jedoch hat sich mein Problem nicht gelöst.

Folgendes Problem und Beispiel (gemäss Anhang): Falls das Datum in der Zelle I3  nicht abgelaufen ist (nicht tiefer als das aktuelle Datum), dann soll er mir die E-Mail Adresse, von der Zeile H3, in die Zeile S3 kopieren. Dies sollte er bei der ganzen Spalte durchführen bis eine leere Zelle kommt. Der Befehl Sollte zusätzlich mit dem Button ausgelöst warden.

Ich habe mit folgendem Ansatz herumexperimentiert, bin aber auf kein funktionierendes Resultat gekommen.

Private Sub CommandButton2_Click()

Dim i As Integer
i = 9
If Cells(i, 1) > Date Then Cells(i, 19) = 10
i = i + 1
End If

End Sub

Ich hoffe ihr könnt mir weiter helfen.

Gruss Matteo

[AlterDresdner]

Hallo Matteo,
vielleicht hilft Dir dieser Ansatz weiter:

Sub TuEs()

Dim zeile As Long
zeile = 3 'Startzeile 
While Not Cells(zeile, 9) = "" And zeile <= Cells(Rows.Count, 9).End(xlUp).Row
  If DateValue(Cells(zeile, 9)) > Date Then Cells(zeile, 19) = Cells(zeile, 8)
  zeile = zeile + 1
Wend

End Sub

[Primo Centurio]

Hallo AlterDresdner

Danke für deine Antwort. Werde es Morgen ausprobieren und mich melden wenn es funzt. Dir noch einen schönen Abend.

Gruss Matteo