Autres Réorganiser deux colonnes sur une seule

[sg394]

Bonjour. J'aurais encore besoin d'un petit coup de main pour une macro. Je voudrais réorganiser les cellules de deux colonnes en une seule de la façon suivante:

avant:
A B
C D
E F
G H

après:
A
B
C
D
E
F
G
H

Mon fichier peut avoir jusqu'à 1000 lignes, il n'y a rien d'autre que les colonnes A et B et si une cellule de la colonne A n'est pas vide, la cellule correspondante de la colonne B n'est pas vide non plus.
Ça semble tellement simple mais je n'y arrive pas. Et je n'ai toujours pas trouvé la solution sur internet. Désolé de vous déranger pour si peu. Merci à ceux qui voudront bien m'aider.

 

[sylvanu]

Bonsoir SG,
Un essai en PJ avec :

Sub Essai()
    Dim N%
    Application.ScreenUpdating = False
    N = 1
    For L = 1 To Range("A65500").End(xlUp).Row
        Cells(N, "D") = Cells(L, "A")
        Cells(N + 1, "D") = Cells(L, "B")
        N = N + 2
    Next L
End Sub

 

[sg394]

C'est rapide! Et c'est pas mal!

Mais j'aurais préféré que les cellules de départ soient effacées et que le résultat final soit en colonne A. C'est pas grave. Ce qui reste est facile. Je devrais y arriver seul. Merci beaucoup!

 

[sylvanu]

Encore eût il fallu le préciser.

 

[sylvanu]

Maintenant que c'est préciser avec :

Sub Essai()
    Dim N%, L%
    Application.ScreenUpdating = False
    DL = Range("A65500").End(xlUp).Row
    If DL < 2 Then Exit Sub
    tablo1 = Range("A1:A" & DL)
    tablo2 = Range("B1:B" & DL)
    Range("A1:B" & DL).ClearContents
    N = 1
    For L = 1 To UBound(tablo1)
        Cells(N, "A") = tablo1(L, 1)
        Cells(N + 1, "A") = tablo2(L, 1)
        N = N + 2
    Next L
End Sub

 

[sg394]

Trop tard! j'ai terminé tout seul! Faut bien que je travaille un peu moi aussi! J'ai seulement ajouté ceci...

Columns("A:C").Select
Selection.Delete Shift:=xlToLeft

Merci encore!

 

[soan]

Bonsoir sg394, sylvanu,

c'est encore plus tard, mais j'propose quand même ma solution ; elle utilise la méthode des tableaux et écrit tous les résultats d'un seul coup ; cette méthode sera très rapide, même sur plusieurs milliers de lignes. ​

fais Ctrl e ➯ travail effectué

Sub Essai()
  Dim nlm&, n1&, n2&: nlm = Rows.Count
  n2 = Cells(nlm, 2).End(3).Row: If n2 = 1 And IsEmpty([B1]) Then Exit Sub
  n1 = Cells(nlm, 1).End(3).Row: Application.ScreenUpdating = 0
  If n1 = 1 And IsEmpty([A1]) Then Columns(1).Delete: Exit Sub
  Dim T1, T2, k&, i&, j&, p&
  T1 = Application.Transpose([A1].Resize(n1))
  T2 = Application.Transpose([B1].Resize(n2))
  k = n1 + n2: ReDim Preserve T1(1 To k): k = n1: i = 1
  Do
    For j = 1 To n2
      If T2(j) <> "" Then
        For p = k To i Step -1: T1(p + 1) = T1(p): Next p
        k = k + 1: i = i + 1: T1(i) = T2(j)
      End If
      i = i + 1
    Next j
  Loop Until i = k + 1
  [A1].Resize(k) = Application.Transpose(T1): Columns(2).Delete
End Sub

soan

 

[sg394]

Merci soan. Je testerais ta solution également. Mais sachant que ce n'est qu'une étape intermédiaire, effectuée automatiquement, de nuit, sur un ordinateur qui n'est pas utilisé pour la bureautique, et pour un cas extrême ne dépassant pas 35 fichiers de 700 lignes, la rapidité d’exécution n'est pas cruciale.