excel如何通过VBA按照日期自动赋值（2）

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        For i = 1 To .Count
            If .Cells(i).Row >= 4 And .Cells(i).Row <= 2000 And .Cells(i).Column = 2 Then
                .Cells(i).Offset(0, 2 + Day(Now)) = .Cells(i)
            End If
        Next i
    End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim tr, tc, k
tr = Target.Row
tc = Target.Column
If tr >= 4 And tc = 2 Then
Y = Date
Set r1 = Rows(1).Find(Y, , , 1)
If Not r1 Is Nothing Then
k = r1.Column
Cells(tr, tc + k - 2) = Cells(tr, tc)
End If
End If
End Sub

写代码可实现，要有文件，说清楚要求！