Microsoft 365 Déplacer un groupe de cellules

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,
Je vous souhaite un beau WE (pas trop chaud) :)

Comme l'indique le titre du fil, je n'arrive pas à réaliser mon besoin : Déplacer un groupe de cellules

1 - déplacer les cellules Col B qui contiennent un n° de téléphone en colonne A au niveau des cellules col B qui contiennent le mot date,
2 - supprimer les lignes des cellules déplacées (cellules col B devenues vides).

Je cherche depuis un bon moment mais j'ai pas trouver le bon code pour l'instant.

Auriez-vous le bon code ?
Je joins un fichier test avec le résultat attendu.

Un grand merci comme d'habitude,
Entre temps, je continue mes recherches et tests.

Amicalement, lionel :)
 

Pièces jointes

  • test.xlsm
    13.9 KB · Affichages: 10
Dernière édition:
Solution
Bonjour Lone-wolf, Robert,

Quel plaisir de te revoir Lone-wolf :)

Comme je le disais cette macro est très rapide :
VB:
Sub Restructurer()
Dim tablo, resu(), i&, n&
With ActiveSheet 'à adapter au besoin
    tablo = .Range("B1:B" & .Cells.SpecialCells(xlCellTypeLastCell).Row).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    ReDim resu(1 To UBound(tablo), 1 To 2)
    For i = 1 To UBound(tablo)
        n = n + 1
        If tablo(i, 1) Like "Expediteur*" Then resu(n, 1) = tablo(i, 1): i = i + 1
        resu(n, 2) = tablo(i, 1)
    Next
    '---restitution---
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A1]
        If n Then .Resize(n, 2) = resu
        .Offset(n).Resize(Rows.Count - n - .Row + 1...

Discussions similaires

Statistiques des forums

Discussions
312 025
Messages
2 084 736
Membres
102 648
dernier inscrit
radhwane taibi