首页 文章

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

提问于
浏览 次
0

我搜索过但找不到我遇到的这个具体问题的答案 . 我正在尝试将一个工作表中的一系列数据复制到另一个工作表上，然后在工作表上标识单元格值，该日期与COPY FROM工作表上的单元格匹配 . 以下是我的代码 . 当我从PASTE TO工作表（'每日摘要记录'）运行它时，宏工作，但如果我从另一个工作表运行它不起作用 . 我希望能够从工作簿中的任何工作表运行它，尤其是从PASTE FROM工作表 . 请参阅两个工作表的图像附件 .

'每日分项'）

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

结束子

'Daily Itemized' 'Daily Summary Record'

excel-vba copy-paste vba excel

2 回答

  • 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
    回复于
  • 0

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

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

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

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

    回复于

相关问题