检查日期范围是否等于今天，并将日期范围以下的值复制到新单元格

Question

我有多个水平日期范围，我需要查看其中是否有一个=今天，如果是，则复制日期下方的单元格值并将其粘贴到新的单元格中。

我设法进行了1对1粘贴和多次复制粘贴。

Sub copyModes()

If Range("R29") = Date Then
    Range("R30:R34").Select
    Selection.Copy
    Range("P37:P41").Select
    ActiveSheet.Paste
End If

If Range("U29") = Date Then
    Range("U30:U34").Select
    Selection.Copy
    Range("P37:P41").Select
    ActiveSheet.Paste
End If

If Range("S29") = Date Then
    Range("S30:S34").Select
    Selection.Copy
    Range("P37:P41").Select
    ActiveSheet.Paste
End If

If Range("T29") = Date Then
    Range("T30:T34").Select
    Selection.Copy
    Range("P37:P41").Select
    ActiveSheet.Paste
End If

If Range("V29") = Date Then
    Range("V30:V34").Select
    Selection.Copy
    Range("P37:P41").Select
    ActiveSheet.Paste
End If

End Sub

Answer 1

您可以这样使用通用子代码：

Sub CheckRangeAndCopy(rng As Range)
    If rng.value = Date Then
        rng.Offset(1, 0).Resize(5, 1).Copy Range("P37:P41")
    End If
End Sub

然后调用它：

CheckRangeAndCopy Range("T29")
CheckRangeAndCopy Range("V29")
' and so on