[VBA] Problème pour copier/coller une image d'un classeur à un autre

Bonjour,

Je dois récupérer des images de plusieurs fichiers excel pour les mettre sur un autre classeur où elles seront centralisées (2 images par fichier). Je réussi à copier/coller la 1ere image, mais lorsque je copie la 2eme je tombe sur cette erreur : "La méthode 'Copy' de l'objet 'Shape' a échoué", quand je vais dans 'debogage' et que je relance l'instruction qui a échouée ça marche, puis ça refait la même chose pour la 2eme image du fichier suivant

Je ne vois pas du tout d'où peut venir ce problème, si vous pouvez m'aider. Voici le code de la fonction qui copie/colle, elle est appelée pour chaque fichier (sheet ws), l'erreur vient au 2eme 'shp.copy'

Sub Photo()

For Each shp In ws.Shapes 'parcours des objets du fichier où se trouve les image à récuperer
        If shp.Type = 13 Then 'si l'objet est une image

            If Not Intersect(shp.TopLeftCell, ws.Range("A62")) Is Nothing Then 'si l'image se trouve à l'emplacement de la 1ere image
                shp.Width = 246 'redimensionnement
                shp.Height = 300
                shp.Copy 'copie de l'image (marche)
                new_C6.Sheets("Photos").Range("A" & idPh).PasteSpecial 'colle dans le classeur où les image seront centralisées
                Application.CutCopyMode = False 'Vide presse papier
                new_C6.Sheets("Photos").Range("A" & idPh + 1).Value = ws.Range("A26").Value & "_1" 'écriture de la description en dessous de la photo               
            End If

            If Not Intersect(shp.TopLeftCell, ws.Range("M62")) Is Nothing Then  'si l'image se trouve à l'emplacement de la 2eme image
                shp.Width = 246 'redimensionnement
                shp.Height = 300
                shp.Copy 'copie de l'image (ne marche pas)
                new_C6.Sheets("Photos").Range("B" & idPh).PasteSpecial  'colle dans le classeur où les image seront centralisées
                Application.CutCopyMode = False 'Vide presse papier
                new_C6.Sheets("Photos").Range("B" & idPh + 1).Value = ws.Range("A26").Value & "_2"  'écriture de la description en dessous de la photo              
            End If

            ws.Activate
        End If
    Next
End Sub

Le message d'erreur était précisément "erreur d'execution '-2147221040 La méthode 'Copy' de l'objet 'Shape' a échoué"

J'ai mis un petit delai de 200 ms avant les 'copy' et ça marche, tout s'enchaine bien, et ça ne ralenti pas trop ma macro. Le presse papier devait avoir du mal à suivre le rythme avec plusieurs copier/coller d'image à la suite

WaitFor (0.2)
shp.Copy
new_C6.Sheets("Photos").Range("A" & idPh).PasteSpecial

'...

'avec
Sub WaitFor(NumOfSeconds As Single)
    Dim SngSec As Single
    SngSec = Timer + NumOfSeconds

    Do While Timer < SngSec
        DoEvents
   Loop
End Sub
Rechercher des sujets similaires à "vba probleme copier coller image classeur"