Microsoft 365 Copie image d'une feuille à une autre feuille en VBA

[Mongo]

Bonjour,

Je cherche à copier un logo d'une feuille "PrixATraiter" vers un feuille "Etiquettes" via une macro, sachant que cette copie sera effectuée quelques centaines de fois pendant la procédure.
J'ai déjà une macro (Sub CreationEtiquettes()) qui fonctionne mais qui bloque sur l'instruction ci-dessous :
ActiveCell.Offset(, 1).Select
Worksheets("PrixATraiter").Shapes("Logo").Copy
Worksheets("Etiquettes").Paste
ActiveCell.Offset(, -1).Select

Ce qui est surprenant, c'est qu'en lançant à nouveau la macro sans l'avoir arrêtée, elle refonctionne sur plusieurs enregistrements puis se bloque à nouveau.
Si quelqu'un a une idée, merci d'avance,

 

[Sheldor]

bonjour,
j'ai laissé juste 7 lignes dans PrixATraiter sinon c'est un peu long...

en cliquant sur "générer étiquettes" chez moi ça bloque juste à la fin sur :

Worksheets("Etiquettes").Range("A1").Select

que j'ai remplacé par :
Worksheets("Etiquettes").Select
Range("A1").Select

 

[sousou]

Bonjour
Tu peux t'inspirer de ceci, je ne traite que l'image, mais les reste est simple
Sub etiquesousou()
With Sheets("PrixAtraiter")

Set zone = .Range(.Cells(2, 1), .Cells(.UsedRange.Rows.Count, 1))
'zone.Select
nbbyligne = 5
debligne = 1
nb = 1
For Each z In zone
Call creer(z, .Shapes("logo"), debligne, nb)
nb = nb + 1
If nb = nbbyligne Then
nb = 1
debligne = debligne + 3

End If
Next
End With
End Sub

Sub creer(z, logo, lg, nb)
With Sheets("Etiquettes")

logo.Copy

.Paste
Set im = Selection
im.Left = .Cells(lg, nb * 2).Left
im.Top = .Cells(lg, nb * 2).Top
End With
End Sub

 

[Mongo]

Avec un peu de retard, merci sousou !