vba粘贴不起作用

Posted 2023-02-25

【中文标题】vba粘贴不起作用

【英文标题】：vba paste not working

【发布时间】：2018-06-09 15:53:47

【问题描述】：

所以到目前为止我已经生成了这段代码，但是我无法让粘贴工作。

这个想法贯穿了 190 个工作簿，并在一些单元格中粘贴公式，在其他单元格中粘贴常数（范围 H1:Z160），对 excel 考试进行评分。如果手动完成，所有公式和常量都会粘贴并工作。

粘贴功能（已标记）失败并出现以下错误：

这是现在更新和更正的代码：

    Option Explicit

Sub Examnew()
    Dim rCell As Range, rRng As Range 'define loop names
    Dim wbmaster As Workbook                     'name for master workbook
    Dim wbtarget As Workbook                      'name for student workbook
   Set wbmaster = ActiveWorkbook               'set the name for the master
   Dim i As Long                                           'a counter for the result pasteback

With Application '<--|turn off screen & alerts only removed while testing
.ScreenUpdating = False
.EnableEvents = False
End With

i = 1   'Set the counter for result paste back

    'Student numbers in cells B3:B136 WARNING SET TO 2 STUDENTS ONLY FOR TEST
    'NOTE that st Nums are in col B with a duplicate in col A to collect results.
    Set rRng = wbmaster.Sheets("studentlist").Range("B3:B4")
    ActiveSheet.DisplayPageBreaks = False '<  | turn off page breaks for speed

    For Each rCell In rRng '<                 | loop through "students" range

         ActiveSheet.DisplayPageBreaks = False '<  | turn off page breaks for speed

      'now open Student exam workbook and set to name "wbtarget"
         Workbooks.Open ("/Users/michael/Final_V1/" & rCell.Value & ".xlsx")
         Set wbtarget = Workbooks(rCell.Value & ".xlsx")

     'do copy & paste from Master to Target
         wbmaster.Sheets("Answers_Source").Range("h1:z160").Copy
         wbtarget.Sheets("ANSWERS").Range("h1:z160").PasteSpecial

         Application.CutCopyMode = False      'Clear the copy command

    'Now collect the result in cell I4 and paste it back into column B using the rCell
    'for that student number matches the st num in col A
        wbtarget.Sheets("Answers").Range("I4").Copy
        wbmaster.Sheets("studentlist").Range("B" & 2 + i).PasteSpecial xlPasteValues

        Application.CutCopyMode = False      'Clear the copy command

     'now save and close the student file...
        wbtarget.Close (True)

        i = i + 1      'increment i for next pasteback


    Next rCell   '<                            | next student number
   'save the results file
   wbmaster.Save


       ActiveSheet.DisplayPageBreaks = True '<    | turn back on page breaks once all done

'turn screen & alerts back on
With Application
.ScreenUpdating = True: .DisplayAlerts = True
'.DisplayPageBreaks = True
End With
End Sub

效果很好，谢谢大家。

【参考方案1】：

该行代码失败的原因是Range 对象没有Paste 方法。

复制粘贴有两种方式。

1) 向 Copy 方法中的 Destination 参数发送一个值。然后，您不需要粘贴命令： wb.Sheets("Answers_Source").Range("h1:z160").Copy _ Destination := wb2.Sheets("Answers").Range("h1:z160")

2) 复制后在目标范围上使用 PasteSpecial 方法，默认情况下会粘贴所有内容，就像标准粘贴一样。

wb2.Sheets("Answers").Range("h1:z160").PasteSpecial

然后要停止您复制的单元格周围的 Marquee（或行进的蚂蚁），以 Application.CutCopyMode = False 结束

【讨论】：

方法一不想玩？但方法 2 效果很好。

很高兴（2）工作。对于 (1)，这可能是我在编辑框中输入的方式。 (1) 的简化示例是Range("A1").Copy Destination:=Range("B1")

【参考方案2】：

尝试删除这些在上下文中无论如何都没有意义的With。

   'do copy from reference "Answers_Source" worksheet
   wb.Sheets("Answers_Source").Range("h1:z160").Copy

   'now paste the formulas into the student exam workbook
   wb2.Sheets("Answers").Range("h1:z160").Paste      

【讨论】：

谢谢你：我认为控制欲太强了。

【参考方案3】：

即使已经回答了这个问题，Range Value property 也应该作为这个问题的一个选项包含在内。

如果您只查看 CopyPasteValues，最好将 Range Value 属性调整为等于源范围值。

几个优点：

没有行军蚂蚁 (Application.CutCopyMode = False)。 屏幕不需要刷机更新/滚动。 应该更快。 您甚至不需要取消隐藏或激活（复制时不需要，但人们认为您会这样做......所以我列出了它！）。

所以我用更改重建了你的宏，虽然我没有做任何其他更改，所以无论你修复了什么，可能需要再次完成。我还包括了第二个宏（TimerMacro），您可以使用它来计算它运行的时间（以防您想测试性能差异）。如果您不使用任何日期，则可以使用属性Value2for a very slight speed improvement，尽管我没有看到这方面的太大改进。 祝你好运！

Sub Examnew_NEW()
    Dim rCell As Range, rRng As Range 'define loop names
    Dim wbmaster As Workbook                     'name for master workbook
    Dim wbtarget As Workbook                      'name for student workbook
   Set wbmaster = ActiveWorkbook               'set the name for the master
   Dim i As Long                                           'a counter for the result pasteback

With Application '<--|turn off screen & alerts only removed while testing
.ScreenUpdating = False
.EnableEvents = False
End With

i = 1   'Set the counter for result paste back

    'Student numbers in cells B3:B136 WARNING SET TO 2 STUDENTS ONLY FOR TEST
    'NOTE that st Nums are in col B with a duplicate in col A to collect results.
    Set rRng = wbmaster.Sheets("studentlist").Range("B3:B4")
    ActiveSheet.DisplayPageBreaks = False '<  | turn off page breaks for speed

    For Each rCell In rRng '<                 | loop through "students" range

         ActiveSheet.DisplayPageBreaks = False '<  | turn off page breaks for speed

      'now open Student exam workbook and set to name "wbtarget"
         Workbooks.Open ("/Users/michael/Final_V1/" & rCell.Value & ".xlsx")
         Set wbtarget = Workbooks(rCell.Value & ".xlsx")

     'do copy & paste from Master to Target
     'PGCodeRider CHANGED!!!!!!!!!!!!!!
     wbtarget.Sheets("ANSWERS").Range("h1:z160").Value = _
         wbmaster.Sheets("Answers_Source").Range("h1:z160").Value


         Application.CutCopyMode = False      'Clear the copy command

    'Now collect the result in cell I4 and paste it back into column B using the rCell
    'for that student number matches the st num in col A


        'PGCodeRider CHANGED!!!!!!!!!!!!!!
        wbmaster.Sheets("studentlist").Range("B" & 2 + i).Value = _
            wbtarget.Sheets("Answers").Range("I4").Value

        Application.CutCopyMode = False      'Clear the copy command

     'now save and close the student file...
        wbtarget.Close (True)

        i = i + 1      'increment i for next pasteback


    Next rCell   '<                            | next student number
   'save the results file
   wbmaster.Save


       ActiveSheet.DisplayPageBreaks = True '<    | turn back on page breaks once all done

'turn screen & alerts back on
With Application
.ScreenUpdating = True: .DisplayAlerts = True
'.DisplayPageBreaks = True
End With
End Sub


Sub timerMACRO()
'Run this if you want to run your macro and then get a timed result
Dim beginTime As Date: beginTime = Now

Call Examnew_NEW

MsgBox DateDiff("S", beginTime, Now) & " seconds."

End Sub

【参考方案4】：

尝试转到 Visual Basic 编辑器 -> 工具 -> 参考。检查您正在使用的参考，看看您是否激活了您需要的所有参考。造成这种情况的根本原因似乎与https://support.microsoft.com/en-ph/help/3025036/cannot-insert-object-error-in-an-activex-custom-office-solution-after 和https://blogs.technet.microsoft.com/the_microsoft_excel_support_team_blog/2014/12/ 中提到的问题有关