Hello everyone

The message in the subjectline is displayed when running the code below:

Option Explicit
Sub FindWeek()
Dim DateCell As Range
Dim Rownr As Integer
Dim ColumnDep As Byte
Dim ShiftDown As Byte
Dim i As Byte

Dim Dsd As String
Dim Msd As String
Dim Ysd As String
Set DateCell = Range("SearchDate")
If Range("Dsd").Value < 10 Then
Dsd = "0" & Range("Dsd").Value
Else:
Dsd = Range("Dsd").Value
End If
If Range("Msd").Value < 10 Then
Msd = "0" & Range("Msd").Value
Else:
Msd = Range("Msd").Value
End If

Ysd = Range("Ysd").Value

DateCell = Dsd & "-" & Msd & "-" & Ysd

Sheets("TotaalTabel").Select

Cells.Find(What:=DateCell.Value, After:=ActiveCell, LookIn:=xlFormulas,
_
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate

Rownr = ActiveCell.Row
ColumnDep = 7
ShiftDown = 3

For i = 1 To 16
Range(Range("SearchDate").Offset(ShiftDown, 0), Range("SearchDate").
_
Offset(ShiftDown, 6)).Copy
Cells(Rownr, ColumnDep).PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ShiftDown = ShiftDown + 1
ColumnDep = ColumnDep + 1
Next i

End Sub