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