Question

我已经搜索过但无法找到我遇到的这个特定问题的答案。我正在尝试将一个工作表中的一系列数据复制到另一个工作表上，然后在工作表上确定单元格值，并按照与COPY FROM工作表上的单元格匹配的日期进行PASTING TO。以下是我的代码。当我从PASTE TO工作表（＆＃39;每日摘要记录＆＃39;）运行它时，宏工作，但如果我从另一个工作表运行它不起作用。我希望能够从工作簿中的任何工作表运行它，尤其是从PASTE FROM工作表。请参阅两个工作表的图像附件。

＆＃39;每日分项＆＃39;）

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

'Daily Itemized' 'Daily Summary Record'

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

此外，因为您只想复制值，所以可以通过绕过剪贴板来改进代码（当代码执行{{1}时，用户将所有其他相关风险复制到剪贴板之间当它执行Copy时，只需将目标区域中的Paste设置为源区域中的Values：

Values

Answer 2

感谢您的帖子。您无法从非活动工作表中选择单元格。这就是为什么它只适用于你在PASTE TO工作表上。

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

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

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

VBA宏代码失败;从范围复制和粘贴到新范围

2 个答案: