错误1004工作表类的粘贴方法失败，间歇

此代码的目的是search并从word文档复制一个数字到Excel电子表格。 它不会一直发生，但是我运行这个脚本时会遇到1004错误。 debugging器突出显示了第一个 “ActiveSheet.Paste”语句，它是在“Do While Loop”之下的代码问题。 我没有看到与脚本的任何其他部分有任何冲突。 任何人发现任何错误？

Sub TorCopy() ' Set variables Dim Word As New Word.Application Dim WordDoc As New Word.Document Dim i As Integer Dim j As Integer Dim r As Word.range Dim Doc_Path As String Dim TOR_Tracker As Excel.Workbook Dim TOR_Tracker_Path As String Dim Whiteboard_Path As String Dim Whiteboard As Excel.Workbook Dim n As Integer ' Set File Path that contains TOR ' Open File Doc_Path = "C:\Word_File.doc" Set WordDoc = Word.Documents.Open(Doc_Path) TOR_Tracker_Path = "C:\Tracker_Spreadsheet.xlsm" Set TOR_Tracker = Workbooks.Open(TOR_Tracker_Path) Whiteboard_Path = "C:\Excel_Spreadsheet_Acting_As_A_Whiteboard.xlsm" Set Whiteboard = Workbooks.Open(Whiteboard_Path) Whiteboard.Worksheets("Sheet1").Activate ' Create a range to search Set r = WordDoc.Content j = 1 ' Find TOR numbers and copy them to whiteboard spreadsheet With r .Find.ClearFormatting With .Find .Text = "TP[0-9]{4}" .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = True End With Do While .Find.Execute = True .Copy ActiveSheet.Cells(j, 1).Select ActiveSheet.Paste j = j + 1 Loop End With ' Filter out duplicate TOR numbers n = Cells(Rows.Count, "A").End(xlUp).Row ActiveSheet.range("A1:A" & n).RemoveDuplicates Columns:=1, Header:=xlNo ' Copy TOR numbers from whiteboard With ActiveSheet .range("A1").Select .range(Selection, Selection.End(xlDown)).Select Selection.Copy End With ' Paste to TOR Tracker TOR_Tracker.Worksheets("Sheet1").Activate With ActiveSheet .range("A1").Select Selection.End(xlDown).Select Selection.End(xlDown).Select Selection.End(xlDown).Select ActiveCell.Offset(1, 4).Select ActiveSheet.Paste End With Whiteboard.Close WordDoc.Close Word.Quit End Sub 

Answer 1

根据评论，我已经修改了代码，以删除使用.Select ， .Activate等types的语句

 Sub TorCopy() ' Set variables Dim Word As New Word.Application Dim WordDoc As New Word.Document Dim i As Integer Dim j As Integer Dim r As Word.range Dim Doc_Path As String Dim TOR_Tracker As Excel.Workbook Dim TOR_Tracker_Path As String Dim Whiteboard_Path As String Dim Whiteboard As Excel.Workbook Dim whiteSheet as Worksheet Dim torSheet as Worksheet Dim n As Integer ' Set File Path that contains TOR ' Open File Doc_Path = "C:\Word_File.doc" Set WordDoc = Word.Documents.Open(Doc_Path) TOR_Tracker_Path = "C:\Tracker_Spreadsheet.xlsm" Set TOR_Tracker = Workbooks.Open(TOR_Tracker_Path) Set torSheet = TOR_Tracker.Worksheets("Sheet1") Whiteboard_Path = "C:\Excel_Spreadsheet_Acting_As_A_Whiteboard.xlsm" Set Whiteboard = Workbooks.Open(Whiteboard_Path) Set whiteSheet = Whiteboard.Worksheets("Sheet1") ' Create a range to search Set r = WordDoc.Content j = 1 ' Find TOR numbers and copy them to whiteboard spreadsheet With r .Find.ClearFormatting With .Find .Text = "TP[0-9]{4}" .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = True End With Do While .Find.Execute = True .Copy whiteSheet.Cells(j, 1).PasteSpecial j = j + 1 Loop End With ' Filter out duplicate TOR numbers n = whiteSheet.Cells(whiteSheet.Rows.Count, "A").End(xlUp).Row whiteSheet.range("A1:A" & n).RemoveDuplicates Columns:=1, Header:=xlNo n = whiteSheet.Cells(whiteSheet.Rows.Count, "A").End(xlUp).Row ' re-getting the last row now duplicates are removed lastRowTor = torSheet.Cells(torSheet.Rows.Count, "A").End(xlUp).Row torSheet.Range("A" & lastRowTor & ":A" & (lastRowTor + n)-1).Value = whiteSheet.Range("A1:A" & n).Value ' sets values in Tor from White without Select, Copy or Paste Whiteboard.Close WordDoc.Close Word.Quit End Sub