Bug lors de multiples collages

Bonjour,

J'ai fais un petit programme simple pour lister des nom de fichiers dans une colonne, récupérer l'information d'une cellule dans chacun de ces fichiers et de coller cette information dans une 2nde colonne.

J'ai réussi à faire tourner le programme entièrement une première fois mais depuis, j'ai une erreur qui apparaît aléatoirement pendant le programme:

Erreur d'execution '1004': La méthode Paste de la classe Worksheet a échoué

L'erreur se fait sur la ligne ActiveSheet.paste

Sub Fichiers() Application.ScreenUpdating = True Dim myPath As String, myFile As Variant Dim paste As String myPath = "C\chemindacces\" 'copier ici le chemin d'accès myFile = Dir(myPath & "\*TEMP*.xlsx*") c = 1 Do While myFile <> "" Cells(c, 1) = myFile Dim wb As Workbook Set wb = Workbooks.Open(myPath & myFile) wb.Activate Sheets(1).Activate Range("E11").Select Selection.Copy ActiveWorkbook.Close Sheets(1).Activate Range("B" & c).Select ActiveSheet.paste myFile = Dir() c = c + 1 Loop End Sub

Du coup je ne comprends pas pourquoi ce bug apparaît aléatoirement, je précise que je peux avoir jusqu'à 400 fichiers à faire

Quelqu'un aurait une explication ?

Merci d'avance,

Robin

Bonjour,

Essai ceci ... ce pourrait aussi être plus rapide ...

Sub Fichiers()
Dim myPath As String, myFile As Variant
Dim C As Integer
Dim Wb0 As Workbook
Dim Wb1 As Workbook

Application.ScreenUpdating = False   '' mettre à False pour geler l'affichage et accélérer le traitement

   myPath = "C:\chemindacces\"  'copier ici le chemin d'accès
   myFile = Dir(myPath & "\*TEMP*.xlsx*")
   Set Wb0 = ThisWorkbook

   C = 1

   Do While myFile <> ""
      Cells(C, 1) = myFile

      Set Wb1 = Workbooks.Open(myPath & myFile)

      Wb1.Sheets(1).Range("E11").Copy Wb0.Sheets(1).Range("B" & C)
      ActiveWorkbook.Close
      myFile = Dir()
      C = C + 1
      Set Wb1 = Nothing
   Loop
End Sub

ric

Ca a l'air de bien rouler merci !

Je clos le sujet donc

ric