Option Explicit

Sub Finden_und_kopieren()
Dim intRow      As Integer
Dim varEingabe  As Variant
'Datumseingabe
varEingabe = InputBox("Bitte Suchdatum eingeben")
'Wenn eingetragenes Datum nicht einem Datumswert entspricht, Prozedur _
 beenden
If IsDate(varEingabe) = False Then Exit Sub
'Schleife zum Finden des eingetragenen Datums
For intRow = 4 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    'Wenn eingetragenes Datum gleich dem Datum der durch die Schleife _
     angesprochene Zelle dann...
    If CDate(ActiveSheet.Cells(intRow, 1)) = CDate(varEingabe) Then
        '...Bereich A:E des gefundenen Datumsbereichs kopieren und in _
         J4 einfügen und...
        With ActiveSheet
            .Range(Cells(intRow, 1), Cells(intRow + 95, 5)).Copy _
                .Range ("J4")
        End With
        '...Schleife verlassen
        Exit For
    End If
Next
End Sub