Erreur d'execution 1004 (ActiveSheet.Paste)

[Escartefigue]

Le forum bonjour,

J'ai un problème avec la commande "ActiveSheet.Paste" de façon aléatoire!
Je m'explique:
Je génère des présentations de produits en copiant des images sur une autre feuille.
Pour ce faire j'ai utilisé la macro suivante:

Private Sub Worksheet_Activate()

' Remise à zéro de l'affichage.
Application.ScreenUpdating = flase
For Each s In ActiveSheet.Shapes
If s.Type = 13 Then s.Delete
Next s
' Fiche N°001.
For Each c In [A1]
If c <> "" Then
lig = [Prez].Find(c, LookAt:=xlWhole).Row
col = [Prez].Column + 1
For Each s In Sheets("Images").Shapes
If s.TopLeftCell.Address = Cells(lig, col).Address Then s.Copy
Next s
ActiveSheet.Paste
Selection.ShapeRange.Left = c.Offset(, 0).Left + 0
Selection.ShapeRange.Top = c.Top + 1
End If
Next c
For Each c In [C26]
If c <> "" Then
lig = [DAS].Find(c, LookAt:=xlWhole).Row
col = [DAS].Column + 1
For Each s In Sheets("Images").Shapes
If s.TopLeftCell.Address = Cells(lig, col).Address Then s.Copy
Next s
ActiveSheet.Paste
Selection.ShapeRange.Left = c.Offset(, 0).Left + 10
Selection.ShapeRange.Top = c.Top + 5
End If
Next c
For Each c In [B26]
If c <> "" Then
lig = [Extr_Inssuf].Find(c, LookAt:=xlWhole).Row
col = [Extr_Inssuf].Column + 1
For Each s In Sheets("Images").Shapes
If s.TopLeftCell.Address = Cells(lig, col).Address Then s.Copy
Next s
ActiveSheet.Paste
Selection.ShapeRange.Left = c.Offset(, 0).Left + 1
Selection.ShapeRange.Top = c.Top + 25
End If
Next c
End Sub

Rien de bien sorcier, la macro marche au poil... enfin pour une feuille! J'ai dû dupliquer 150 fois la partie de génération de présentation (1 par page) et c'est là que les choses ce gâtes!

La macro étant trop longue j'ai dû la découper en 10 macros (1 macro de remise à zéro de la présentation, 8 macros de génération de présentation (20 pages par macro) et une macro qui démarre toutes les macros lorsque l'on ouvre la feuille concernée.

La plus part du temps j'ai cette erreur 1004 (mais pas tout le temps) et jamais au même endroit ou sur la même macro, ce qui me fait me dire que c'est un problème de cash mémoire dû a un trop grands nombre de copier/coller.

Pour moi la solution était de rajouter la ligne de commande "Application.CutCopyMode = False" a la fin de chaque page mais visiblement ça ne marche pas!

Quelqu'un aurait une idée s'il vous plait????

 

[Escartefigue]

Re : Erreur d'execution 1004 (ActiveSheet.Paste)

Re

Personnellement , je réduirais un peu le code en utilisant cette syntaxe.
NB: Par principe, pas besoin de mot de passe quand on est phase de test, non
(surtout sur un fichier exemple ... )
Code VBA:
Sub Prez_Gen_1()
' Fiche N°001.
Dim adres, zones, i%, col&, lig&
adres = Array("A1", "C26", "B26")
zones = Array("Prez", "DAS", "Extr_Inssuf")
For i = 0 To UBound(adres)
If Not IsEmpty(Range(adres(i))) Then
lig = Range(zones(i)).Find(Range(adres(i)), LookAt:=xlWhole).Row
col = Range(zones(i)).Column + 1
For Each s In Sheets("Images").Shapes
If s.TopLeftCell.Address = Cells(lig, col).Address Then s.Copy
Next s
ActiveSheet.Paste
Selection.ShapeRange.Left = Range(adres(i)).Offset(, 0).Left + 0
Selection.ShapeRange.Top = Range(adres(i)).Top + 1
End If
Next i
'Faire selon la même logique pour les autres fiches
'-----------
' reste du code à modifier ... ou pas
End sub

Bonjour Staple1600, bonjour le forum,

J'ai essayé ta formule mais je n'y arrive pas!

Robert m'a fait une formule qui marche au poil avec une boucle la voici

Sub Prez_Gen_1()
Dim i As Object 'déclare la variable i (onglet Images)
Dim f As Object 'déclare la variable f (Fiche Selection))
Dim fs As Integer 'déclare la variable fs (FicheS)
Dim lig As Integer 'déclare la variable lig (LIGne)
Dim col As Integer 'déclare la variable col (COLonne)

'fiches N° 1 à 50
Application.ScreenUpdating = False 'masque les raffraîchissement d'écran
Set i = Sheets("Images") 'définit l'inglet i
Set f = Sheets("Fiche Selection")
For fs = 1 To 2450 Step 49 'boucles 1 : des lignes 1 à 2450 par pas de 49
If f.Cells(fs, 1).Value <> "" Then 'condition : si la cellule ligne fs, colonne 1 n'est pas vide
'puisque la plage nommée "Prez" est fixe et correspond à D22 pour ne pas écrire [Lig = 22] et [col = 5] ?
lig = Range("Prez").Find(f.Cells(fs, 1), LookAt:=xlWhole).Row 'définit la ligne lig
col = Range("Prez").Column + 1 'définit la colonne col
'puisque la plage nommée "Prez" est fixe et correspond à D22 pour ne pas écrire [Lig = 22] et [col = 5] ?
For Each s In Sheets("Images").Shapes 'boucle 2 : sur tous les objets "Shape" s de l'onglet "Images"
'si l'objet s se trouve dans la cellule en ligne li, colonne col, copie l'image et sort de la boucle
If s.TopLeftCell.Address = i.Cells(lig, col).Address Then s.Copy: Exit For
Next s 'prochain objet shape de la boucle 2
f.Paste 'copie l'objet s dans l'onglet "Fiche Selection"
'positionne l'objet s
Selection.ShapeRange.Left = f.Cells(fs, 1).Offset(, 0).Left + 0 'à gauche
Selection.ShapeRange.Top = f.Cells(fs, 1).Top + 1 'en haut
End If 'fin de la condition
'commentaires idem pour les cellules en colonne C puis B
If f.Cells(fs + 25, 3).Value <> "" Then
lig = Range("DAS").Find(f.Cells(fs + 25, 3).Value, LookAt:=xlWhole).Row
col = Range("DAS").Column + 1
For Each s In Sheets("Images").Shapes
If s.TopLeftCell.Address = i.Cells(lig, col).Address Then s.Copy: Exit For
Next s
f.Paste
Selection.ShapeRange.Left = f.Cells(fs + 25, 3).Offset(, 0).Left + 10
Selection.ShapeRange.Top = f.Cells(fs + 25, 3).Top + 5
End If

If f.Cells(fs + 25, 2).Value <> "" Then
lig = Range("Extr_Inssuf").Find(f.Cells(fs + 25, 2).Value, LookAt:=xlWhole).Row
col = [Extr_Inssuf].Column + 1
For Each s In Sheets("Images").Shapes
If s.TopLeftCell.Address = i.Cells(lig, col).Address Then s.Copy: Exit For
Next s
f.Paste
Selection.ShapeRange.Left = f.Cells(fs + 25, 2).Offset(, 0).Left + 1
Selection.ShapeRange.Top = f.Cells(fs + 25, 2).Top + 20
End If
Next fs
Application.ScreenUpdating = True
End Sub

Encore un grand merci à Robert

 

[Staple1600]

Re : Erreur d'execution 1004 (ActiveSheet.Paste)

Bonsoir à tous

Tant mieux si la boucle de Robert boucle la question

Merci en tout cas à toi, Escartefigue, d'avoir posté cette solution de Robert
(qui peut-être intéressera d'autres membres du forum)

 

[Robert]

Re : Erreur d'execution 1004 (ActiveSheet.Paste)

Convenances...