Programme pour faire passer des colonnes cote à cote, en colonne à la file

[amauryde]

Bonsoir à tous,

Voici un programme qui n'est peut-être pas possible de créer mais qui me permettrait de ne pas passer des nuits blanches sur notre cher Excel.

Voila dans le fichier, ci-joint, vous pouvez voir deux onglets, l'onglet "a" qui est ma base et l'onglet "b" qui doit être mon résultat.

Mon but est de passer toutes mes infos de a à b , c'est à dire de mettre mes deux colonnes de droite (montées et descentes) en dessous de mes deux colonnes de gauche (montées et descentes) et ainsi de suite.
Sachant que j'ai certains fichiers qui font 300 colonnes, ça m'aiderait bcp d'avoir une macro, que j'adapterai s'il faut selon le fichier...

En espérant avoir été assez clair,

Merci à vous,

Ps: j'ai internet jusqu'à 19h30

modif: les couleurs de l'onglet b ne sont pas nécessaires

 

[ERIC S]

Re : Programme pour faire passer des colonnes cote à cote, en colonne à la file

Bonsoir

cela a l'air de marcher. Le principe est là mais je vais partir bientôt donc j'ai testé a minima

Sub e()
dercol = Sheets("a").Cells(2, Columns.Count).End(xlToLeft).Column
derligne = Sheets("a").Range("A" & Rows.Count).End(xlUp).Row
nouvligne = Sheets("b").Range("B" & Rows.Count).End(xlUp).Row + 1
For i = 2 To dercol Step 2
    For j = 3 To derligne
        Sheets("b").Cells(nouvligne, 2).Value = Sheets("a").Cells(j, 1).Value
        Sheets("b").Cells(nouvligne, 3).Value = Sheets("a").Cells(j, i).Value
        Sheets("b").Cells(nouvligne, 4).Value = Sheets("a").Cells(j, i + 1).Value
        nouvligne = nouvligne + 1
    Next
Next
End Sub

 

[amauryde]

Re : Programme pour faire passer des colonnes cote à cote, en colonne à la file

je vais tester et essayer de l'adapter, et je te redis

Merci bcp Eric S

 

[Efgé]

Re : Programme pour faire passer des colonnes cote à cote, en colonne à la file

Bonjour amauryde, ERIC S,
Le même principe que ERIC S, mais par "paquets"

Sub test()
Dim i&, LstRw As Long, Arrets As Variant, LstCel As Range
With Sheets("a")
    LstRw = .Cells(Rows.Count, 1).End(xlUp).Row
    Arrets = .Range(.Cells(3, 1), .Cells(LstRw, 1))
    For i = 2 To .Cells(2, Columns.Count).End(xlToLeft).Column Step 2
        Set LstCel = Sheets("b").Cells(Rows.Count, 1).End(xlUp)(2)
        LstCel.Resize(UBound(Arrets, 1), 1) = Arrets
        .Range(.Cells(3, i), .Cells(LstRw, i + 1)).Copy LstCel.Offset(0, 1)
    Next i
End With
End Sub

Cordialement

 

[amauryde]

Re : Programme pour faire passer des colonnes cote à cote, en colonne à la file

merci à toi aussi Efgé, je vais voir lequel est le plus facile à adapter

 

[Efgé]

Re : Programme pour faire passer des colonnes cote à cote, en colonne à la file

Re
Erreur de colonne :

 Set LstCel = Sheets("b").Cells(Rows.Count, 2).End(xlUp)(2)

Sheets("b").Cells(Rows.Count, 2)
Cordialement