Question

所以我到目前为止已经生成了这段代码，但我无法使用该代码。

这个想法贯穿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

哪个效果很好，谢谢你们。

Answer 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

结束

Answer 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

Answer 3

即使已经回答了这个问题，Range Value property仍应作为此问题的选项。

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

几个优点：

没有行军蚁（Application.CutCopyMode = False）。
屏幕不需要刷新/滚动。
应该更快。
您甚至不需要取消隐藏或激活（您不需要使用“复制”功能，但是人们认为您可以...所以我要列出它！）。

所以我用更改重建了宏，尽管我没有进行任何其他更改，所以您固定的其他内容可能都需要再次进行。我还包括了第二个宏（TimerMacro），您可以使用它来计时它运行多长时间（以防您要测试性能差异）。如果您没有使用任何日期，则可以使用属性Value2 for 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

Answer 4

尝试使用visual basic editor - ＆gt;工具 - ＆gt;参考。检查您正在使用的参考，看看您是否激活了所需的所有参考。其根本原因似乎与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/

中提到的问题有关

vba粘贴不起作用

4 个答案: