VBA將日期添加到當前選擇右側的每個單元格？

Question

我需要一些我正在使用的Excel VBA的幫助，當前腳本會檢查一行中的日期，如果它是過去的日期，則會將范圍粘貼到行A中的下一個空單元格中。該范圍當前為63行，但可能更改。

我需要做的是還將今天的日期添加到腳本剛剛粘貼的每個條目右側的單元格中。

任何幫助是極大的贊賞。 謝謝

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim Adm As Worksheet
Dim rng1 As Range
Dim NextRow As Range

Set ws = Sheets("Booking Count")
Set Adm = Sheets("Admin")
Set rng1 = ws.Columns("B:B").Find("*", ws.[B1], xlValues, , xlByRows, xlPrevious)

If Not rng1 Is Nothing Then
If CDate(rng1) < Date Then
    Set NextRow = ws.Range("A" & ws.UsedRange.Rows.Count - 61)
    Adm.Range("AllStaff").Copy
    ws.Activate
    NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
    Application.CutCopyMode = False
    Set NextRow = Nothing
    Sheets("Home").Activate
    Else
    MsgBox "The date entered into the TextBox is equal to today or later."
End If
Else
End If
Application.ScreenUpdating = True
End Sub

Answer 1

需要在偏移和添加日期之前命名粘貼范圍。

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim Adm As Worksheet
Dim rng1 As Range
Dim NextRow As Range
Dim NextRow2 As Range

Set ws = Sheets("Booking Count")
Set Adm = Sheets("Admin")
Set rng1 = ws.Columns("B:B").Find("*", ws.[B1], xlValues, , xlByRows, xlPrevious)

If Not rng1 Is Nothing Then
If CDate(rng1) < Date Then
    Set NextRow = ws.Range("A" & ws.UsedRange.Rows.Count - 61)
    Adm.Range("AllStaff").Copy
    ws.Activate
    NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
    Set NextRow2 = Selection
    Selection.Offset(0, 1).Value = Now()
    Application.CutCopyMode = False
    Set NextRow = Nothing
    Sheets("Home").Activate
    Else
    MsgBox "The date entered into the TextBox is equal to today or later."
End If
Else
End If
Application.ScreenUpdating = True
End Sub