Sub test()
Dim strNames(20) As String
Dim a As Integer
Dim Inhalt As String
Dim strText As String
strText = " Es gibt Einträge +8"
Dim intCounter As Integer
Dim cell As Range
For Each cell In Range("F1:F454")
If cell.Value >= DateAdd("d", 1, Now()) And cell.Value <= DateAdd("d", 8, Now()) Then
intCounter = intCounter + 1
a = cell.Rows.Count
strNames(intCounter) = Cells(a, 1).Value
MsgBox a
End If
Next cell
For i = 1 To intCounter
Inhalt = Inhalt & "AB NR." & strNames(i) & Chr(13)
Next i
MsgBox "Folgende Aufträge müssen innerhalb von 8 Tagen geliefert werden:" & Chr(13) & Inhalt
End Sub