Error 1004 Paste Method of Worksheet Class Failed, Intermittent

Question

The purpose of this code is to search for and copy a number from a word document to an excel spreadsheet. It doesn't happen all of the time, but I am getting the 1004 error from time to time when I run this script. The debugger highlights the first "ActiveSheet.Paste" statement, which is under the "Do While Loop" as the problem with the code. I am not seeing any conflicts with any other part of the script. Anyone spot anything incorrect?

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

Is there ever an instance where TOR_Tracker.Worksheets("Sheet1") doesn't exist? Also you can just put .Paste, the With already specifies the ActiveSheet. — Ryan Wildry
Avoid use of .Select and ActiveSheet where possible. You don't really need to use either. Set an object reference to the specific worksheet you want to use in the file and refer to that instead. It's quicker and more reliable. — Dave
I just edited my post, there are two ActiveSheet.Paste statements, and I am only having issues with the first one. @Dave, can you give an example of what you mean by setting an object reference to the specific worksheet? — electronicaneer
Set whiteboard = Whiteboard.Worksheets("Sheet1") will allow you to refer to that worksheet anywhere in the code (well, anywhere it's in scope anyway) with whiteboard, e.g. whiteboard.Range("A1").Value would get you the content of A1 on the specified worksheet. If nothing else it will make your code more readable — Dave
See posted answer. Let me know if it doesn't work, it's coded off the top of my head and I haven't had a chance to test it! — Dave

Dave Dave · Accepted Answer · 2016-06-15T14:09:39

As per the comments, I've modified the code to remove the use of .Select, .Activate etc type statements

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

Error 1004 Paste Method of Worksheet Class Failed, Intermittent

1 Answers