Hallo Holger,

versuch mal so ob es das macht was du möchtest

Option Explicit
Sub Kopieren()
Dim qR As Range
Dim dR As Range
Dim zR As Range

Set qR = Application.Names("_SleepTime").RefersToRange
Set dR = Application.Names("_DayString").RefersToRange

Set zR = dR.Find(Date)
If Not zR Is Nothing Then
    qR.Copy zR.Offset(1, 0)
End If
End Sub

Sub X()
Dim qR As Range

Set qR = Application.Names("_SleepTime").RefersToRange


    qR.NumberFormat = "General"
    With qR
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With qR.Font
        .Name = "Times New Roman"
        .FontStyle = "Standard"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    qR.Borders(xlDiagonalDown).LineStyle = xlNone
    qR.Borders(xlDiagonalUp).LineStyle = xlNone
    With qR.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With qR.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With qR.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With qR.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    qR.Borders(xlInsideVertical).LineStyle = xlNone
    With qR.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With qR.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

End Sub