XL 2013 [résolu]Répéter macro en décalant cellule de référence

[Etn]

Bonjour le forum !

J’ai créé une macro à l’aide de l’enregistreur de macro, me permettant de dupliquer les colonnes jaunes (voir fichier ci-joint) à la même hauteur que sa colonne de droite.

Néanmoins cette macro s’effectue tant que la cellule bleue est non vide.

J’ai donc créé et répété la macro de base en changeant à chaque fois la cellule de référence (décaler de 3 cellules à chaque fois).

C’est long et il y a une limite de taille, qui je pense pourrait être contourné.

Serait il possible d’optimiser cette macro afin qu’elle ne fasse pas 10000 lignes ?

Range("AA9").Select
  Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(500, 0)).Select
  Selection.ClearContents
  ActiveCell.Offset(-1, 0).Select
  Selection.Copy
  ActiveCell.Offset(0, 1).Select
  ActiveCell.End(xlDown).Offset(0, -1).Select
  Range(Selection, Selection.End(xlUp)).Select
  ActiveSheet.Paste

If IsEmpty(Range("AD9")) Then Exit Sub
Range("AD9").Select
  Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(500, 0)).Select
  Selection.ClearContents
  ActiveCell.Offset(-1, 0).Select
  Selection.Copy
  ActiveCell.Offset(0, 1).Select
  ActiveCell.End(xlDown).Offset(0, -1).Select
  Range(Selection, Selection.End(xlUp)).Select
  ActiveSheet.Paste

If IsEmpty(Range("AG9")) Then Exit Sub
Range("AG9").Select
  Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(500, 0)).Select
  Selection.ClearContents
  ActiveCell.Offset(-1, 0).Select
  Selection.Copy
  ActiveCell.Offset(0, 1).Select
  ActiveCell.End(xlDown).Offset(0, -1).Select
  Range(Selection, Selection.End(xlUp)).Select
  ActiveSheet.Paste

Je n'ai copié que les 3 premières, en vrai y en a 70 environ.

Bonne journée,

Etn

 

[zebanx]

Bonjour Etn,

Je n'ai pas compris ce que tu cherchais à faire néanmoins, par rapport à la macro DUPLIQUER_SPREAD tu peux t'inspirer du code suivant si tu utilises un pas (step) exact de 3 colonnes.

cdlt
thierry

---------------
Sub dupliquer()
j = [AA1].Column 'colonne de démarrage

For i = j To 50 Step 3 '(à toi de calibrer un chiffre de colonne - on fait bien un step de +3 colonnes)
If IsEmpty(Cells(9, i)) Then Exit Sub 'mieux vaut utiliser cells(ligne, colonne) que range car cells ne contient que des chiffres!
Cells(9, i).Select
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(500, 0)).Select
Selection.ClearContents
ActiveCell.Offset(-1, 0).Select
Selection.Copy
ActiveCell.Offset(0, 1).Select
ActiveCell.End(xlDown).Offset(0, -1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Next i

End Sub

 

[Etn]

Bonjour zebanx et merci pour ton aide !

Alors c'est exactement ce que je recherche, après l'avoir testé je souhaiterais ajouter une autre condition :

Sub dupliquer()
 j = [AC1].Column 'colonne de démarrage

 For i = j To 50 Step 3 '(à toi de calibrer un chiffre de colonne - on fait bien un step de +3 colonnes)
 If IsEmpty(Cells(7, i)) Then Exit Sub 'mieux vaut utiliser cells(ligne, colonne) que range car cells ne contient que des chiffres!
 If IsEmpty(Cells(9, i - 2)) Then Exit Sub 'Je veux changer cet Exit Sub
 Cells(9, i - 2).Select
 Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(500, 0)).Select
 Selection.ClearContents
 ActiveCell.Offset(-1, 0).Select
 Selection.Copy
 ActiveCell.Offset(0, 1).Select
 ActiveCell.End(xlDown).Offset(0, -1).Select
 Range(Selection, Selection.End(xlUp)).Select
 ActiveSheet.Paste
 Next i

 End Sub

Je souhaiterais avoir à la place de la 2e condition "If IsEmpty ... Then Exit Sub" aller directement à la dernière ligne ("...Then Next i")

Cdlt, Etn

 

[zebanx]

Rebonjour Etn

ça ?

---

Sub dupliquer2()
j = [AC1].Column 'colonne de démarrage

For i = j To j + 50 Step 3
If IsEmpty(Cells(7, i)) Then Exit Sub
If IsEmpty(Cells(9, i - 2)) Then
Else
Cells(9, i - 2).Select
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(500, 0)).Select
Selection.ClearContents
ActiveCell.Offset(-1, 0).Select
Selection.Copy
ActiveCell.Offset(0, 1).Select
ActiveCell.End(xlDown).Offset(0, -1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
End If
Next i

End Sub

 

[Etn]

C'est parfait !

Merci beaucoup pour ton aide !

Bonne journée,

Etn