Autres Réorganiser deux colonnes sur une seule

  • Initiateur de la discussion Initiateur de la discussion sg394
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

sg394

XLDnaute Nouveau
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.
 
Solution
Maintenant que c'est préciser avec :
VB:
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
Bonsoir SG,
Un essai en PJ avec :
VB:
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
 

Pièces jointes

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! 😀
 
Maintenant que c'est préciser avec :
VB:
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
 

Pièces jointes

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é

VB:
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
 

Pièces jointes

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.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
13
Affichages
203
Retour