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

VBA将日期添加到当前选择右侧的每个单元格？

1 个答案: