Copier et coller en transposant plusieur lignes

[Irénéo]

J'ai sous Excel des résultats de badges que je dois organiser dans un fichier de reprise pour qu'ils puissent être lus par un autre logiciel.
Les résultats sont en colonne, je dois les mettre en ligne dans le fichier de reprise.
Voilà les tâches à effectuer :

1/ sous la première ligne : créer 23 lignes de manière à en avoir en tout 24 pour 1 badge

2/ copier la ligne des 24 agents chimiques (de J1 à AG1) et collage spécial/transposer en se mettant dans C2

3/ copier la ligne des résultas des mesures (de J2 à AG2) et collag spécial/transposer en se positionnant dans la cellule F2

4/ reprendre à 1/ et ainsi de suite....

Il y a environ 3000 lignes

Grand merci par avance

 

[skoobi]

Re : Copier et coller en transposant plusieur lignes

Bonjour Irénéo, bienvenue sur XLD,

quand on reprend à 1, on va à la 25eme ligne de quelle colonne?
2/ collage en C2 ok mais après?
3/ collage en F2 ok mais après?

pas très clair tout ça.
Un fichier bien commenté nous permettra de mieux comprendre.

 

[Irénéo]

Re : Copier et coller en transposant plusieur lignes

Dans le fichier ci-joint on voit les cellules jaunes du bandeau titre (J1;AJ1) sont copier et transposer entre chaque ligne colonne C ligne 2 pour la premiere manip puis 24 lignes plus bas dans la colonne C et ainsi dessuite. Par contre les cellules bleu (J2;AJ2) qui sont les valeurs sont copier et transposer entre chaque ligne colonne F cellule 2 puis les cellules verte (J3;AJ3) qui sont les valeurs sont copier 24 lignes plus bas a partir de F2 et ainsi dessuite, j'ai 3000 lignes à modifier

 

[skoobi]

Re : Copier et coller en transposant plusieur lignes

Re,

je te propose ce code:

Sub test()
Dim Mesure As Range, NextLig As Long
For Each Mesure In Range("J2:J" & [J65536].End(xlUp).Row)
  NextLig = [C65536].End(xlUp).Offset(1).Row
  Range("C" & NextLig & ":C" & NextLig + 23) = Application.Transpose([J1:AG1])
  Range("F" & NextLig & ":F" & NextLig + 23) = Application.Transpose(Mesure.Resize(1, 24))
Next
End Sub

 

[Irénéo]

Re : Copier et coller en transposant plusieur lignes

Bonjour Skoobi,
ton code fonctionne, seulement les autres colonnes ne se décalent pas comme la C et la F. Comment dois-je faire?
Je te remercie par avance pour ton aide précieuse.

 

[skoobi]

Re : Copier et coller en transposant plusieur lignes

Bonjour Irénéo, je pense que tu parles des colonnes A,B,D et E.
Arfff, désolé, un oubli.

voici les ajouts en bleu:

Sub test()
Dim Mesure As Range, NextLig As Long
For Each Mesure In Range("J2:J" & [J65536].End(xlUp).Row)
  NextLig = [C65536].End(xlUp).Offset(1).Row
[COLOR=Blue][B]  Range("A" & NextLig + 1 & ":B" & NextLig + 23).Insert xlShiftDown
  Range("D" & NextLig + 1 & ":E" & NextLig + 23).Insert xlShiftDown[/B][/COLOR]
  Range("C" & NextLig & ":C" & NextLig + 23) = Application.Transpose([J1:AG1])
  Range("F" & NextLig & ":F" & NextLig + 23) = Application.Transpose(Mesure.Resize(1, 24))
Next
End Sub

 

[Irénéo]

Re : Copier et coller en transposant plusieur lignes

Grand merci!!
Tu es impressionnant