ActiveSheet.Paste is failing in Excel vetrsion 2010. I'm getting the following error.
Runtime error '1004'
paste method of worksheet class failed
But when I run in debug mode ActiveSheet.Paste works.
The macro reads a selected pdf file and writes to a excel sheet. Below is the code .
Any ideas why ActiveSheet.Paste is failing in the code below. The same code works in Excel 2002
_____________________________________________________________________________________________________________
Sub cherche(nomfich, Optional ferme = False)
adracrobat = ThisWorkbook.Sheets(1).Range("g1")
ThisWorkbook.Sheets(2).Cells.ClearContents
''réinitialiser phrase
'For num = 0 To 20
'phrase(num) = ""
'Next
''liste des mots
'ReDim mots(0)
'For col = 3 To ThisWorkbook.Sheets(1).Rows(3).Cells.Find("*", , , , , xlPrevious).Column
'ReDim Preserve mots(col - 3)
'mots(col - 3) = ThisWorkbook.Sheets(1).Cells(3, col)
'phrase(0) = phrase(0) & ", """ & mots(col - 3) & """ pas trouvé"
'Next col
'phrase(0) = Right(phrase(0), Len(phrase(0)) - 2)
'ouvrir le fichier pdf
'numID = Shell(adracrobat & " " & rep & "\" & nomfich, vbMaximizedFocus)
numID = Shell(adracrobat & " " & nomfich, vbMaximizedFocus)
Application.Wait (Now + 2 / 3600 / 24)
SendKeys "{ENTER}", True
While Not cherche_fen("adobe") And Not cherche_fen("acrobat")
Wend
'ouvre le fichier
nbessai = 0
While Not cherche_fen(nomfich) And nbessai < 50
nbessai = nbessai + 1
SendKeys "{ENTER}", True 'si pb type de fichier
Wend
'try to go on a page
'SendKeys "{CTRLDOWN}"
'SendKeys "{ENTER}"
''SendKeys "%EF", True
''SendKeys "sealed", True
'SendKeys "+{TAB 2}", True
SendKeys "{ENTER}", True
SendKeys "^H", True
''''copier le texte
'''SendKeys "^F", True
'''SendKeys "sealed", True
'''SendKeys "{TAB 7}", True
'''SendKeys "{ENTER}", True
''''SendKeys "^F", True
'''nbessai = 0
'''
'''While Not cherche_fen(nomfich) And nbessai < 50
'''nbessai = nbessai + 1
'''SendKeys "{ENTER}", True 'si pb type de fichier
'''Wend
'''SendKeys "sealed", True
'''SendKeys "{ENTER}", True
SendKeys "^a^c", True
SendKeys "^w", True
SendKeys "%{F4}", True
'If ferme Then SendKeys "^q", True
'coller dans l'onglet 2
Windows(ThisWorkbook.Name).Activate
ThisWorkbook.Activate
Sheets(2).Select
Cells(2, 1).Select
ActiveSheet.Paste
'Send keys : ****
SendKeys "{TAB 2}", True
SendKeys "{ENTER 2}", True
Sheets(1).Select
Range("B9").Select
'Cells(1).Select
'Set trv = Cells(1)
'num = 0
''rechercher les mots dans l'onglet 2
'For nummot = 0 To UBound(mots)
'If Trim(mots(nummot)) <> "" Then
'Set trv = Cells.Find(mots(nummot))
'While (Not trv Is Nothing) And num < 20
'phrase(num) = Trim(trv.Offset(-1, 0) & " " & trv & " " & trv.Offset(1, 0))
'trv.ClearContents
'num = num + 1
'Set trv = Cells.Find(mots(nummot))
'Wend
'End If
'Next
'If Not trv Is Nothing And num > 0 Then phrase(num) = "...il y a d'autres occurrences du mot cherché dans le fichier"
'Sheets(1).Select
'Sheets(2).Cells.ClearContents
End Sub
Bookmarks