Discussion :

[bigs3232]

j"ai les données sur colonne A en vertical comme ceci

colonne A
aa1
aa2
aa3
aa4
aa5

j'aimerais couper en 2 pour avoir sur 2 colonnes

colonne A colonne b
aa1 aa2
aa3 aa4
aa5

je ne sais pas comment coder çà en vba
merci pour votre aide

[joe.levrai]

Bonjour,

exemple trivial à adapter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Option Base 1
Sub toto()
Dim Tabl(), TabRes(), Milieu As Long, i As Long, j As Long
Tabl = Application.Transpose(Cells(1, 1).CurrentRegion.Value) ' adapter la feuille et la plage des données aspirées
Milieu = UBound(Tabl) / 2                                     ' la moitié des données (sans gestion pair/impair)
ReDim TabRes(Milieu + 1, 2)                                   ' le tableau final
TabRes(1, 2) = "Colonne B"                                    ' écriture manuelle du titre de colonne
j = 1                                                         ' compteur pour la colonne B
    For i = LBound(Tabl) To UBound(Tabl)                      ' boucle sur les données
        If i <= Milieu + 1 Then                               ' la première moitié dans la colonne A
            TabRes(i, 1) = Tabl(i)
        Else                                                  ' la seconde dans la colonne B
            j = j + 1
            TabRes(j, 2) = Tabl(i)
        End If
    Next i
 
    ' restitution sur une nouvelle feuille
    With ThisWorkbook.Worksheets.Add
        .Cells(1, 1).Resize(UBound(TabRes, 1), UBound(TabRes, 2)).Value = TabRes
    End With
End Sub

fait à l'arrache, y'a probablement plus simple



EDIT : et voilà quand on fait à l'arrache ! Je pensais qu'on faisait moitié/moitié or tu veux alterner une valeur sur 2

voici, c'est presque identique

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Option Base 1
Sub toto()
Dim Tabl(), TabRes(), i As Long, j As Long
Tabl = Application.Transpose(Cells(1, 1).CurrentRegion.Value)
Milieu = UBound(Tabl) / 2
ReDim TabRes(Milieu + 1, 2)
TabRes(1, 1) = Tabl(1)
TabRes(1, 2) = "Colonne B"
j = 2
    For i = LBound(Tabl) + 1 To UBound(Tabl)
        If i Mod 2 = 0 Then
            TabRes(j, 1) = Tabl(i)
        Else
            TabRes(j, 2) = Tabl(i)
            j = j + 1
        End If
    Next i
 
    With ThisWorkbook.Worksheets.Add
        .Cells(1, 1).Resize(UBound(TabRes, 1), UBound(TabRes, 2)).Value = TabRes
    End With
End Sub

[bigs3232]

c'est vrai des fois c'est long comme code pour faire quelque chose de simple .
mais bon je me contenterai de ton code .je ne pense pas qu'il y ait plus simple

[RyuAutodidacte]

Bonjour,

autre proposition :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub test()
Dim Col$, debut As Byte, DL&, M&, Tabl, VA, i&, j&
    Col = "A": debut = 1:  DL = Cells(Rows.Count, Col).End(xlUp).Row:  M = Application.RoundUp(DL / 2, 0)
    ReDim Tabl(1 To M, 1 To 2)
    VA = Range(Cells(debut, Col), Cells(DL, Col)).Value
    For i = debut To DL Step 2
       j = j + 1
       Tabl(j, 1) = VA(i, 1): If i + 1 <= DL Then Tabl(j, 2) = VA(i + 1, 1)
    Next
    Cells(1, Col).Offset(, 3).Resize(UBound(Tabl, 1), UBound(Tabl, 2)) = Tabl
 End Sub

[riaolle]

Bonjour,
Une autre idée (je ne sais pas si c'est plus rapide cependant ...) :

1. Ecrire a sur une ligne sur 2 et b sur les autres lignes (en colonne B) --> utiliser AutoFill
2. Filtrer sur les a et faire une copier-coller de la colonne A (dans une autre feuille)
3. Filtrer sur les b et faire une copier-coller de la colonne A à côté du premier collage.

[bigs3232]

pour joe il y a une erreur sur le ligne TabRes(i, 1) = Tabl(i) .je ne sais pas pourquoi
le code de RyuAutodidacte est parfait.pas d'erreur