当从范围复制和粘贴到新范围时，VBA宏代码为什么失败？

Question

我试图将一系列数据从一个工作表复制到不同的工作表，在识别出我要粘贴到的工作表上的单元格值与“复制自”工作表中的单元格匹配的日期之后。当我从“粘贴到”工作表（“每日摘要记录”）运行宏时，该宏起作用，但如果我从另一个工作表运行该宏，则该宏不起作用。我希望能够从工作簿中的任何工作表运行它，尤其是从PASTE from工作表运行。

以下是我的代码：

'Daily Itemized')

Sub ArchiveWeek()

    Set thisMon = Worksheets("Daily Itemized").Range("F5") 'Assigns variable thisMon as the date value in Daily Itemized Tab, F5 cell
        
    Dim ws As Excel.Worksheet
    Dim FoundCell As Excel.Range
     
    Set ws = Worksheets("Daily Summary Record")
    Set FoundCell = ws.Range("D:D").Find(what:=thisMon, lookat:=xlWhole)
    If Not FoundCell Is Nothing Then
        FoundCell.Offset(0, 1).Select 'PROBLEM. Supposed to: Selects the cell to the adjacent right of the cell in column D with the same date as the Itemized F5 cell
        Worksheets("Daily Itemized").Range("G5:S11").Copy  'Works to copy range on Daily sheet
        FoundCell.Offset(0, 1).Select 'reselects the cell to right of FoundCell
        Selection.PasteSpecial xlPasteValues  'works!
        MsgBox ("Your week time values have been pasted!")
    Else
        MsgBox ("The Date of " & thisMon & " was not found in the Daily Summary Record, Column D. Recheck values.")
    End If
    
End Sub

有关两个工作表的图像，请参阅附件：

'每日明细'

“每日摘要记录”

Answer 1

感谢您的帖子。不能从非活动工作表中选择单元格。这就是为什么它仅在您在“粘贴到”工作表上时才有效。

要解决此问题，请考虑对您的代码进行此小更改：

    ...
If Not FoundCell Is Nothing Then
    ws.Select
    ...

这应确保在执行其余代码之前激活 PASTE TO 工作表。

Answer 2

尽可能避免使用选择（以及选择和激活）：

Sub ArchiveWeek()
    Set thisMon = Worksheets("Daily Itemized").Range("F5") 'Assigns variable thisMon as the date value in Daily Itemized Tab, F5 cell

    Dim ws As Excel.Worksheet
    Dim FoundCell As Excel.Range

    Set ws = Worksheets("Daily Summary Record")
    Set FoundCell = ws.Range("D:D").Find(what:=thisMon, lookat:=xlWhole)
    If Not FoundCell Is Nothing Then
        'Copy range on Daily sheet
        Worksheets("Daily Itemized").Range("G5:S11").Copy
        'Paste it on the summary sheet commencing one cell
        ' to the right of the location of the date
        FoundCell.Offset(0, 1).PasteSpecial xlPasteValues
        MsgBox ("Your week time values have been pasted!")
    Else
        MsgBox ("The Date of " & thisMon & " was not found in the Daily Summary Record, Column D. Recheck values.")
    End If

此外，因为您只想复制值，所以您可以通过绕过剪贴板来改进您的代码(在您的代码执行< code >复制和执行< code >粘贴之间，存在用户将其他内容复制到剪贴板的所有相关风险)，并且只需将目标区域中的< code >值设置为源区域中的< code >值:

Sub ArchiveWeek()
    Set thisMon = Worksheets("Daily Itemized").Range("F5") 'Assigns variable thisMon as the date value in Daily Itemized Tab, F5 cell

    Dim ws As Excel.Worksheet
    Dim FoundCell As Excel.Range

    Set ws = Worksheets("Daily Summary Record")
    Set FoundCell = ws.Range("D:D").Find(what:=thisMon, lookat:=xlWhole)
    If Not FoundCell Is Nothing Then
        'Copy values from Daily sheet to Summary sheet, commencing
        ' one cell to the right of the location of the date
        FoundCell.Offset(0, 1).Resize(7, 13).Value = _
                    Worksheets("Daily Itemized").Range("G5:S11").Value
        MsgBox ("Your week time values have been pasted!")
    Else
        MsgBox ("The Date of " & thisMon & " was not found in the Daily Summary Record, Column D. Recheck values.")
    End If