VBA添加date到当前select的右侧的每个单元格？

我需要一些Excel VBA工作的帮助，当前的脚本检查一个date的行，如果它是在过去，它将行范围粘贴到行A中的下一个空单元格。范围目前63行，但可能更改。

我需要做的是将今天的date添加到脚本刚刚粘贴的每个条目右侧的单元格中。

任何帮助是极大的赞赏。 谢谢

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

需要在抵消和添加date之前命名粘贴的范围。

 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