Bug occassionnel de code

Question

J'ai un problème sur lequel je bloque sévère. En gros la partie suivante bug de temps en temps sur la ligne : ws.Cells(derlig, 1).PasteSpecial (xlPasteValues) 'colle toutes les tables dans excel Pour avoir une visualisation du contexte de la phrase c'est ici (le code total est en bas du message) : ' -4- Copier les tables de Word dans Excel ------------------------------------------------------------------- For k = 1 To WDoc.Tables.Count 'boucle selon nombre de table dans le dossier Word derlig = ws.Range("A" &amp; Rows.Count).End(xlUp).Row + 1 '1re ligne de donnée (mettre dans boucle pour créer décalage) WDoc.Tables(k).Range.Copy ' Copie toutes les table du fichier Word ws.Cells(derlig, 1).PasteSpecial (xlPasteValues) 'colle toutes les tables dans excel Next k Le principe est de récupérer les infos contenu dans divers tableau d'un fichier word. le code marche très bien au départ et puis ça bug avec le message erreur : "erreur d’exécution '1004' la méthode Pastespécial de la classe range a échoué" j’effectue un débogage avec F5 ou F8 et le code se relance soit jusqu'au bout soit il s’interrompe à la boucle suivante. du coup en y allant petit à petit ça fonctionne mais pas en mode lecture normal. Au départ j'avais quelque ".Select" que j'ai supprimé : pas de modif J'ai essayé "Application.cutcopyMode = False" : pas de modif en gros le seul moyen que j'ai trouvé c'est de redémarrer le PC quand il y a le bug. Du coup connaissez-vous un moyen de palier à ce problème? Merci d'avance. Code complet : Sub Importation_Info_Word() 'ouverture word; copier-coller; triage; ' -1- Déclaration des variables ------------------------------------------------------------------------------- Dim wb As Workbook 'classeur Excel dans lequel on importe les données Dim ws As Worksheet 'onglet Excel dans lequel on importe les données Dim sNomFichier As Variant 'nom du fichier Word Dim WApp As Object, WDoc As Object Dim derlig As Integer, réponse As Variant Dim x As Variant, m As Integer, k As Integer Sheets.Add before:=Sheets(1) 'ajout d'une feuille devant la première ' -2- Initialisation des variables------------------------------------------------------------------------------ Set wb = ThisWorkbook Set ws = wb.Sheets(1) 'abréviation pour le code ' -3- ouverture fichier Word----------------------------------------------------------------------------------- sNomFichier = Application.GetOpenFilename("All Files (*.*),*.*") 'ouvrir l'application parcourir If sNomFichier = False Then Application.DisplayAlerts = False Sheets(1).Delete Application.DisplayAlerts = True Application.ScreenUpdating = True Exit Sub 'gestion annulation parcourir End If Set WApp = CreateObject("Word.Application") 'pour créer un objet Word WApp.Visible = True 'ne pas afficher Word pendant l'exécution Application.ScreenUpdating = False ' ne pas faire les maj de l'écran Set WDoc = WApp.Documents.Open(sNomFichier) 'ouvre le document Word '3 bis-----------------Donne n° de Pecch / et date --------------------------------- 'x = "" 'm = 1 'Do Until IsNumeric(x) ' x = Left(Mid(sNomFichier, InStrRev(sNomFichier, "#") + 1), m) ' m = m + 1 'Loop ' Sheets("Accueil").Range("C1").Value = x Sheets("gestion").Range("A2").Value = sNomFichier UserForm3.Show If Sheets("Gestion").Range("B3") &lt;&gt; "" Then WDoc.Close False WApp.Quit Application.ScreenUpdating = True Exit Sub End If Sheets("Accueil").Range("Q25").Clear Sheets("Accueil").Range("H1").EntireColumn.AutoFit Sheets("Accueil").Range("M1").EntireColumn.AutoFit ' -4- Copier les tables de Word dans Excel ------------------------------------------------------------------- For k = 1 To WDoc.Tables.Count 'boucle selon nombre de table dans le dossier Word derlig = ws.Range("A" &amp; Rows.Count).End(xlUp).Row + 1 '1re ligne de donnée (mettre dans boucle pour créer décalage) WDoc.Tables(k).Range.Copy ' Copie toutes les table du fichier Word ws.Cells(derlig, 1).PasteSpecial (xlPasteValues) 'colle toutes les tables dans excel Next k WDoc.Close False 'fermer le document Word sans enregistrer ' -5- Répartiton des Grpt et des retour modules ---------------------------------------------------------------- Sheets(1).Select 'selection feuille 1 Rows("1:1").Select 'selection A1 Selection.Delete Shift:=xlUp 'supprime 1ere ligne (vide) Columns("A:E").Select 'selection colonne A:E derlig = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row Sheets(1).Range("$A$1:$E$" &amp; derlig).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), _ Header:=xlNo ' supprime les doubblons dans la feuille excel comprenant les tables copiées Application.ScreenUpdating = True ' ne pas faire les maj de l'écran WApp.Quit 'Fermer l'instance de Word End Sub...

galopin01 · Answer

Essaie de glisser un DoEvents avant le Next ... DoEvents Next A+...

galopin01 · Answer

Oui j'aurai pu me douter au vue du 1004...

Autre suggestion :

derlig = ws.Range("A" & ws.Rows.Count).End(xlUp).Row + 1

Même observation quelques lignes plus bas avec le Sheets(1) Bien que tu n'auras sans doute pas de pb car tu es dans une série de Select...

Mé on se demande pourquoi tu as déclaré ws si tu ne t'en sers que de temps en temps...

..

M'enfin dans ce genre de truc, surtout quand tu travailles sur plusieurs feuilles (ou documents) il vaut mieux préciser pour chaque Range ou Row ou Column la feuille cible. (ou alors c'est que que tu as mis un with... mais dans ce cas c'est le "." qui est de rigueur...

C'est tout ce que je pourrais te dire avec ce seul code.

Sinon sur la logique tu commences par rajouter une feuille pour mieux la supprimer

if sNomFichier = False '...

Moi je ne rajouterai la feuille que si j'en ai besoin !

A+