Création d'une boucle à partir d'un code linéaire

Bonjour à tous!

Alors voici mon petit soucis:
J'ai écrit un code me permettant de copier une ligne (en l'occurrence A2) pour ensuite la coller plusieurs fois en dessous (je ne prend que les champs allant de A à P).
Par la suite, je copie 1 par 1 les cases Q2, R2, S2, T2, U2 ,V2 pour les coller sur la colonne QX correspondante.

Voici le code:

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37

Sub Macro6() 'copie de la ligne 3 Rows("3:3").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("A2:P2").Select Selection.Copy Range("A3").Select ActiveSheet.Paste 'copie du format 3 Range("R2").Select Application.CutCopyMode = False Selection.Copy Range("Q3").Select ActiveSheet.Paste 'suppression de la colonne format 3 Range("R1:R2").Select Range("R2").Activate Selection.ClearContents 'copie de la ligne 3 Rows("4:4").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("A3:P3").Select Selection.Copy Range("A4").Select ActiveSheet.Paste 'copie du format 3 Range("S2").Select Application.CutCopyMode = False Selection.Copy Range("Q4").Select ActiveSheet.Paste 'suppression de la colonne format 3 Range("S1:S2").Select Range("S2").Activate Selection.ClearContents End Sub

---

J'aimerais faire une boucle pour que le processus s'exécute jusqu'en bas de la worksheet pour chaque ligne (Malgré mes tentatives je n'y parviens pas).

Merci à celui qui m'aidera (si tu habites à l'est de Paris, je serais ravi de t'offrir une bonne pinte ou un café! :D

Salut,
ça donne un vertige ces Selects intempestifs.
Sache que l'enregistreur macro est un traceur d'actions permettant pour un débutant de connaître rapidement la syntaxe de certaines expressions du modèle objet VBA. En production le code de l'enregistreur non remanié est source de bugs.
Fais une petite recherche dans les tutos vba de dev pour améliorer ton codage.
Une boucle n'est pas forcément utile dans ton cas.
Et je te propose comme début d'examiner le code suivant en essayant d'imaginer ce qu'il fera avant éxecution:

Code:

---

1 2 3 4 5 6 7

Range("A2:P2").Copy Range("A3:P9").Insert xlDown   Range("r2:v2").Copy Range("q3:q9").PasteSpecial xlPasteAll, , , True   Range("r2:v2").Clear

---

Merci beaucoup pour ton code, effectivement il est beaucoup plus elegant que le mien.
Je comprends bien ce qu'il fait, en revanche j'ai du me méprendre dans l'explication precise du code que j'aimerais exécuter.
Je met deux photo avant/après ainsi qu'un XLS avec l'avant en haut et l'après en bas

Il faudrait que cela se fasse sur toute la worksheet (d'ou mon idée du boucle).

Avant:
Pièce jointe 224837

Après:
Pièce jointe 224841

Si vous etes encore motivés pour m'aider :)

Citation:

---

Envoyé par VBAeater

Je met ... ainsi qu'un XLS avec l'avant en haut et l'après en bas

---

Désolé. C'est le genre d'extension que je redoute le plus, encore que par habitude, je préfère qu'on m'évite cette tâche de devoir chercher à comprendre en téléchargeant un fichier, même pour un fichier brut .txt.
Il suffit que tu t'expliques assez bien. Le fichier, c'est à ceux qui veulent s'assurer de proposer une solution adaptée de te le réclamer.

Citation:

---

Si vous etes encore motivés pour m'aider :)

---

:ptdr::ptdr:

Tu es bien marrant toi.
Allez j'ai la comprenette parfois asse fine, parfois :aie:.
Je vais te relire pour bien cerner, si d'ici là tu peux apporter des points d'éclaircissements qui peuvent m'aider ou d'autres, car je laisse tomber quand je ne comprends pas l'objectif de la chose. Parfois même l'utilité. C'est au gré des humeurs du jour.:mrgreen:

Edit :
M'enfin :

Citation:

---

J'ai écrit un code me permettant de copier une ligne (en l'occurrence A2) pour ensuite la coller plusieurs fois en dessous (je ne prend que les champs allant de A à P).
Par la suite, je copie 1 par 1 les cases Q2, R2, S2, T2, U2 ,V2 pour les coller sur la colonne QX correspondante.

---

Je suis sûr que cet extrait est assez claire, que les images confirment ce qu'il faut comprendre, que le fichier est inutile, que l'exemple de code qui t'a été proposé va dans ce sens.
Peut-être faudrait aménager pour l'insertion de lignes pour éviter un décalage avec les données des colonnes adjacentes.
Edit 2:
Je te suggères de modifier la ligne de code Range("q3:q9")... par A3:A9. peut-être ?

Et bien! Que de méfiance!

La seule chose que je cherche est de transformer mon tableau comme representé sur l'image "avant" en image "après".
Je n'ai forcé personne a ouvrir mon xls, c'est la raison pour laquelle j'ai posté des photos.

Je pensais etre mieux accueilli sur un forum que l'on m'a conseillé (mon prof de prog mobile de l'année derniere étant redacteur/moderateur sur le site).

Je n'ai ni menacé ni agressé personne, je pense donc que ce n'est pas des manières de parler à quelqu'un cherchant de l'aide.

Citation:

---

Envoyé par VBAeater

... je pense donc que ce n'est pas des manières de parler à quelqu'un cherchant de l'aide.

---

Doucement. Pourquoi tu t'emportes pour presque rien ?

Relis les Edits de ma réponse précédente..
Je dois te dire que ce ne sont pas des réactions convenables à quelqu'un qui vient chercher de l'aide.

Bonjour
Tu es venu (tes mots) chercher de l'aide ?
La mienne s'exprime ainsi ('après avoir lu tes messages et "remarques") :
- parcours des lignes de bas en haut
---- a chaque ligne :
------- insertion de 6 nouvelles lignes (Insert, méthode sans ton aide VBA)
------- utilisation de la méthode Transpose (WorksheetFunction.Transpose, méthode dans ton aide VBA)
Bonne lecture et application.

EDIT :

Citation:

---

Si vous etes encore motivés pour m'aider

---

certainement, si tu l'es pour t'y mettre sur ces bases et que tu nous montres ce que tu en fais.

Bonjour,

un exemple fait à la va "très" vite.

Remplacer Feuil1 par la bonne feuille, le résultat part dans une nouvelle feuille
On pourrait transposer en amont le tableau plutôt que de transposer les colonnes ... d'où le "à la va très vite"

Code:

---

1 2 3 4 5 6 7 8 9 10 11

Sub ioio() Dim Tabl(), i As Long Tabl = Feuil1.Cells(1, 1).CurrentRegion.Value   With ThisWorkbook.Worksheets.Add For i = LBound(Tabl, 1) To UBound(Tabl, 1) .Cells(1, i).Resize(UBound(Tabl, 2), 1).Value = Application.Transpose(Application.Index(Tabl, i, 0)) Next i End With   End Sub

---

EDIT : désolé, j'ai mal imprimé ta copie écran quand j'ai rédigé ça .... ce n'est pas tout à fait le résultat attendu.
Je dois partir, si pas de solution à mon retour j'aménage ma propo


EDIT 2 : voilà qui est beaucoup plus conforme

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Sub ioio() Dim Tabl(), i As Long Tabl = Feuil1.Cells(1, 1).CurrentRegion.Value   With ThisWorkbook.Worksheets.Add .Cells(1, 1).Value = "RESULTAT" For i = LBound(Tabl, 1) To UBound(Tabl, 1) .Cells(.Rows.Count, 1).End(xlUp)(2).Resize(UBound(Tabl, 2), 1).Value = Application.Transpose(Application.Index(Tabl, i, 0)) Next i End With   End Sub

---

@joe.levrai

Merci Beaucoup de ton aide!
Je comprends tout à fait ton code mais en l'executant j'ai une erreur 424 objet requis. C'est la ligne Tabl = Feuil1.Cells(1, 1).CurrentRegion.Value qui pose problème, je ne suis pas parvenu à trouver de solution.

Edit:
Autant pour moi, cela fonctionne très bien sur mon PC mais sur mon Mac cela me donne une erreur 424, peu importe, c'est tout à fait ce que je cherchais! Merci beaucoup!!*

Edit2:
Est il possible pour toi de modifier un peu la mise en forme, l'affichage se fait de cette manière grace à ton code
Pièce jointe 224866

or je me demande s'il est possible d'avoir quelque chose comme ça
Pièce jointe 224867

j'ai essayé de modifier la boucle pour le faire, sans succès.

Merci encore!

Bonjour,
ce type de de code marche très bien sur Mac (je suis sur Mac aussi)
Il faut juste cherché ce qui coince ;)

Edit : je viens d'essayer sur Mac le 2è code de @joe.levrai avec le classeur fourni dans le post => aucun souci, pas d'erreur

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21

Sub ioio() Dim TablItem(), TablExemple(), i As Long   With Feuil1.Cells(1, 1).CurrentRegion TablExemple = Application.Transpose(.Columns(1).Value) TablItem = .Offset(0, 1).Resize(.Rows.Count, .Columns.Count - 1).Value End With   With ThisWorkbook.Worksheets.Add .Cells(1, 1).Value = "EXEMPLE" .Cells(1, 2).Value = "ITEM"   For i = LBound(TablExemple) To UBound(TablExemple) With .Cells(.Rows.Count, 1).End(xlUp)(2).Resize(UBound(TablItem, 2), 1) .Value = TablExemple(i) .Offset(0, 1).Value = Application.Transpose(Application.Index(TablItem, i, 0)) End With Next i End With   End Sub

---

Pour deux colonnes :

- exemples en colonne A
- les "items" en colonne B

sur une nouvelle feuille crée à la volée

Top du Top! Merci à tous!!!!