Microsoft 365 Déplacer un groupe de cellules

Usine à gaz · 30 Juillet 2022

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

job75 · 30 Juillet 2022

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...

Lone-wolf · 30 Juillet 2022

Usine à gaz à dit:
Bonjour Mon Wolf préféré car le seul que je connaisse
Content de voir ton message.
Tu vas bien ?
Bon WE

Hello Boy!

Oui, merci, je vais bien. Et toi?
Bon weekend à toi et tout le Fil.

Lone-wolf · 30 Juillet 2022

Robert, mapomme, à vous aussi: très heureux de vous relire.

Microsoft 365 Déplacer un groupe de cellules

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

job75

Lone-wolf

XLDnaute Barbatruc

Lone-wolf

XLDnaute Barbatruc

Discussions similaires