Problème avec cel.Offset

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim cel As Range, c As Range
Dim lig, i, x As Long
If Not Intersect(Target, Range("d1:x100")) Is Nothing Then Exit Sub


With Sheets(1).Range("a2:a30")
 Set c = .Find(ActiveCell, LookIn:=xlValues)
    For Each cel In ActiveSheet.Range("d65536").End(xlUp)
      If Not c Is Nothing Then cel.Offset(1, 0).Value = c.Value
     Next cel
  End With
  
  With ActiveSheet
    lig = ActiveSheet.Range("d65536").End(xlUp).Row
For i = 5 To 28
  For x = 2 To lig
    If .Cells(5, i).Value = Date Then .Cells(x + 5, i).Value = .Cells(x, 4).Value
Next x
Next i
End With
End Sub