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

Question

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

尽可能避免使用Select（以及Selection和Activate）：

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

---

另外，因为您只想复制值，您可以通过绕过剪贴板来改进您的代码（在您的代码执行 Copy 和当它执行Paste) 并且只是将目标区域中的Values 设置为源区域中的Values：

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

Answer 2

感谢您的帖子。您不能从非活动工作表中选择单元格。这就是为什么它只在您使用 PASTE TO 工作表时才有效。

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

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

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