Clipboard error copying from Excel to Word document

user_10586443 0
Viewed 1128

I am trying to copy text in Excel cells (cell A1 to A66) into a Word document. The goal of this operation is to copy it and paste it as TEXT. If copied directly from Excel, it will paste as a TABLE.

Private Sub Bouton1_Click()
    
    Dim objWord As New Word.Application
    With objWord
        .Documents.Add
        Application.Wait (Now + TimeValue("0:00:01") / 2)
        Worksheets("Description2").Cells(1, 1).Copy
        Application.Wait (Now + TimeValue("0:00:01") / 2)
        .Selection.PasteSpecial xlPasteValues
        .Visible = True
    End With
    
    Dim i As Integer
    For i = 2 To 66
        If Worksheets("Description2").Cells(i, 1) = Worksheets("Description2").Cells(i + 1, 1) Then Exit For
        With objWord
            Application.Wait (Now + TimeValue("0:00:01") / 2)
            Worksheets("Description2").Cells(i, 1).Copy
            Application.Wait (Now + TimeValue("0:00:01") / 2)
            .Selection.PasteSpecial xlPasteValues
            .Visible = True
        End With
    Next i
    
    objWord.Application.Activate
    objWord.Application.WindowState = wdWindowStateMaximize
    
End Sub

This code works about 70% of the time. When it doesn't work, I get this error (or a variation, but always concerning the clipboard):

Run-Time error "4605": This method or property is not available
because the clipboard is empty or not valid.

Also, sometimes a random OneDrive window opens.

I've added the Application.Wait lines to try to slow down the copy/paste, but it doesn't do that much.

How can I make my code more reliable?

ms-word clipboard vba excel
2 Answers

If you want to paste as text, perhaps:

Sub CopyAsTextToWord()
    Dim wordApp As New Word.Application

    With wordApp
        .Visible = True
        .Documents.Add

        Worksheets("Description2").Range("A1:A66").Copy
        .Selection.PasteSpecial DataType:=wdPasteText
    End With
End Sub

If on the other hand you want to paste each cell one at a time (this is what it seems like from your original code, not sure), perhaps a slightly different approach, avoiding the clipboard. Read the range into an array, iterate through it and then use Selection.TypeText to "paste" each element sequentially. Probably can be made more robust.

Sub TransferAsText()
    Dim wordApp As New Word.Application

    With wordApp
        .Visible = True
        .Documents.Add

        Dim arr()
        arr = Worksheets("Description2").Range("A1:A66").Value

        Dim i As Long
        For i = LBound(arr, 1) To UBound(arr, 1)
            .Selection.TypeText Text:=CStr(arr(i, 1))
        Next i
    End With
End Sub
user_92458530

Write a separate function and capture all data from excel in an ArrayList

Function GetDataFromExcel()
    
    CreateObject ("Excel.Application")
    Dim xlApp As Excel.Application, xObjFD As FileDialog
    Set xlApp = New Excel.Application
    xlApp.Visible = True
    Set xObjFD = Application.FileDialog(msoFileDialogFilePicker)
    xObjFD.Title = "Select the excel file location " & FileType
    
    With xObjFD
        .AllowMultiSelect = False
        .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm; *.xlsb", 1
        .Show
        
        ' Selection is not null
        If .SelectedItems.Count > 0 Then
            xFilePath = .SelectedItems.Item(1)
        Else
            Exit Function
        End If
        
        Dim xlWorkBook As Object, valueCollected As String, _
        rowCount As Integer : rowCount = 1
        Set xlWorkBook = xlApp.Workbooks.Open(xFilePath, True, False)
        xlWorkBook.Activate
        Set ArrayValues = New ArrayList
        
loopToCollectData:
        On Error GoTo er
        valueCollected = xlApp.ActiveWorkbook.Sheets("Description2").Range("A" & rowCount).Value
        If valueCollected <> "" Then
            ArrayValues.Add valueCollected
            If rowCount < 66 then
                rowCount = rowCount + 1
                GoTo loopToCollectData
            End If
        End If
    End With
    
    xlWorkBook.Close
    xlApp.Visible = False
    Exit Function

er:
    xlWorkBook.Close
    xlApp.Visible = False
    MsgBox "Please select the relevant input file!"
    End

End Function

Once data is collected, then it is independent of the application and could be used inside the word application.

An Array could be also used to collect the data by using the range.

Function GetDataFromExcel()   
     '     Some Code ===========     
     dataArrayCollected = Application.Transpose(Range(Cells(1, 1), Cells(66, 1)))
      '     Some more Code ===========   
      '     No more code ===========    
End Function
user_71717580
Related