أخي الكريم حسين
جرب الكود التالي عله يكون المطلوب إن شاء الله
Sub Test()
Dim Cel As Range
If Not Intersect(ActiveCell, Range("A2:A100")) Is Nothing Then
For Each Cel In Selection
If IsEmpty(Cel) Then
Cel.Value = Cel.Offset(, 1).Value
Cel.Offset(, 1).ClearContents
Cel.Offset(, 2).Value = Date
End If
Next Cel
End If
End Sub
تقبل تحياتي