thespeedy20
XLDnaute Occasionnel
Bonjour le Forum,
J'ai une zone de texte dans une cellule(A2), le nombre de répétition en B2... dans la feuille Shape, j'aimerais copier cette zone de texte à intervalle régulier(ex: toutes les 50lignes) dans la feuille copie.
Pour l'instant j'arrive à faire la copie avec la macro suivante mais j 'ai décalage entre les zones de texte... J'aimerais aussi pouvoir changer la cellule de départ
J'ai un bouton sur la feuille shape pour la copie, quand je l'utilise les shapes ne sont copiés au bon endroit, si je suis dans l'éditeur, c'est copié au bon endroit avec décalage
Merci d'avance pour votre aide
OLi
J'ai une zone de texte dans une cellule(A2), le nombre de répétition en B2... dans la feuille Shape, j'aimerais copier cette zone de texte à intervalle régulier(ex: toutes les 50lignes) dans la feuille copie.
Pour l'instant j'arrive à faire la copie avec la macro suivante mais j 'ai décalage entre les zones de texte... J'aimerais aussi pouvoir changer la cellule de départ
J'ai un bouton sur la feuille shape pour la copie, quand je l'utilise les shapes ne sont copiés au bon endroit, si je suis dans l'éditeur, c'est copié au bon endroit avec décalage
VB:
Sub Copiexfois()
Dim r As Range, sh As Shape, shCopy As Shape, i As Long, nCol As Long
Dim nRow As Long, j As Long, ctr As Long
nCol = 1
Application.ScreenUpdating = False
For Each sh In Worksheets("Copie").Shapes
sh.Delete
Next sh
For Each r In Worksheets("Shape").Range("B2", Worksheets("Shape").Range("B" & Rows.Count).End(xlUp))
For Each sh In Worksheets("Shape").Shapes
If Not Intersect(sh.TopLeftCell, r.Offset(, -1)) Is Nothing Then Exit For
Next sh
For i = 1 To r.Value
ctr = ctr + 1
sh.Copy
With Worksheets("Copie")
DoEvents
.Paste
Set shCopy = .Shapes(.Shapes.Count)
If ctr Mod nCol = 1 Then
j = 0
nRow = nRow + 1
End If
shCopy.Top = j * (Cells(j + 50, 1).Top) '20 distance entre shapes
shCopy.Left = Cells(1, 5).Left
j = j + 1
End With
Next i
Next r
Application.ScreenUpdating = True
End SubMerci d'avance pour votre aide
OLi