Déplacement sélectif de cellules

Version imprimable

Voir 40 message(s) de cette discussion en une page

20/12/2013, 19h46
jpvba65

Déplacement sélectif de cellules

Bonjour à tous et toutes

Voici ce que je recherche

J'ai une cellule (B1) avec un texte "blabla" que l'on peut retrouver x fois dans la colonne B.
Je voudrais que la cellule à côté (C1) soit copiée puis collée dans la colonne A
jusqu'à la dernière ligne avant la prochaine cellule en B contenant le texte "blabla".
(exemple: le prochain "blabla" est en B16, il faut que le copié/collé précédent se fasse jusqu'en A15).
Ce cycle de recherche de la cellule "blabla" et de copié/collé de la cellule d'à côté devra s'effectuer jusqu'à la dernière cellule "blabla" de la colonne B et dans ce cas le copié/collé s'arrêtera à la dernière cellule non vide en B.
Une fois fait il faudra supprimer toutes les lignes contenant un texte spécifique "toto".

Merci d'avance pour toute aide

Bonne soirée

Bonjour à tous je sais pas si j'ai compris ton pb
mais essaye ça
Code:

1 2 3 4 5 6 7 8 Sub blabla() derl = Cells(65000, 2).End(xlUp).Row For i = 1 To derl If Cells(i, 2) <> "blabla" Then Cells(i, 1) = Cells(i, 3) end if Next i End Sub
pour toto c'est dans quel colonne qu'il se trouve
cordialement

déplacement sélectif des cellules

bonjour,

toto est certainement colonne B. Dans ce cas :

Code:

1
2
3
4
5
6
7
8
9
10
 
Sub blabla()
derl = Cells(65000, 2).End(xlUp).Row
For i = derl To 1 Step -1       ' boucle en remontant des lors qu'il y a suppression possible
    If Cells(i, 2) <> "blabla" Then
       Cells(i, 1) = Cells(i, 3)
    End If
    If Cells(i, 2) = "toto" Then Cells(i, 2).EntireRow.Delete
Next i
End Sub

cordialement

21/12/2013, 15h36
Marc-L

Bonjour jpvba65,

différentes possibilités (réalisable sans boucler sur toutes les lignes), c'est selon comment est organisée la feuille
mais sans la voir (l'idéal étant un classeur avant / après) …

Utilise l'Enregistreur de macros afin de te donner une base de code que tu publieras ici afin de le complèter ci-besoin
accompagné d'une présentation claire & exhaustive …
21/12/2013, 16h30
jpvba65

1 pièce(s) jointe(s)

bonjour Spookyz

Un grand merci pour l'aide que tu m'apportes.
J'ai essayé ton code, c'est pas loin de ce que je recherche mais c'est pas encore ça.
Pour être plus clair sur mon besoin je joins un tableau qui sera plus explicite.
Pour ce qui est de "toto", en fait cela concerne les lignes (voir tableau) marquée ligne à supprimer. Pour le principe j'aimerais savoir comment supprimer une ligne entière qui contient un texte "au choix".
Sinon comme tu verras dans le cas de mon tableau ce sont les lignes en dessous de "blabla".
Je précise que "blabla" est toujours en B et que le texte à copier toujours en C
(à côté de "blabla").
Comme indiqué sur mon premier message le premier "blabla" est en B1.
Cerise sur le gâteau et parce que c'est bientôt Noêl peut tu me donner l'explication de chaque ligne de code.

Cdlt
21/12/2013, 17h16
Marc-L

Apparemment, ce sont chaque ligne "blabla" et sa suivante qui doivent être systématiquement supprimées.

Le tableau réel commence bien en B1 ?

Sinon il y a d'autres méthodes plus rapides sans boucler sur toutes les lignes.
Tout dépend en fait du nombre total de lignes à traiter …
21/12/2013, 18h49
jpvba65

Bonjour Marc-L

Effectivement
Une fois le copié/collé de la cellule à droite de "blabla" effectué, la ligne complète est supprimée.
La ligne suivante est supprimée sans aucun autre traitement.

Le tableau démarre en B1 et la colonne A est totalement vide au départ.

Quand aux nombre de lignes il est indéfini
(pour info j'ai un tableau en cours qui contient 250 lignes).

Cdlt

Bonsoir,
essaye ça peut être

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub blabla()
Dim tb()
j = 0
derl = Cells(65000, 2).End(xlUp).Row
    For i = 1 To derl
        If Cells(i, 2) = "blabla" Then
            tx = Cells(i, 3)
            Cells(i + 2, 1) = Cells(i, 3)
            Else
            Cells(i + 2, 1) = tx
        End If
    Next i
 
 
With ActiveSheet.Range("a1:c500")
    Set c = .Find("blabla", LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            ReDim Preserve tb(j)
            tb(j) = c.Row
            j = j + 1
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
 
Rows(derl + 2).Delete
Rows(derl + 1).Delete
 
    For k = UBound(tb) To 0 Step -1
        Rows(tb(k) + 1).Delete
        Rows(tb(k)).Delete
    Next k
 
End Sub

cordialement

Au lieu de boucler sur toutes les cellules, plus efficace est d'utiliser un filtre ou une recherche …

Code à insérer dans le module de classe de la feuille à traiter :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 Sub Demo() Dim Deb As Range, Fin As Range If Me.[C1].Value = "" Then Beep: Exit Sub Application.ScreenUpdating = False Set Deb = Me.[B1] With Deb.CurrentRegion.Columns(2) Set Fin = .Find(Deb.Value, Deb, xlValues, xlWhole, , , True) Do Until Fin.Address = Deb.Address Range(Deb(3, 0), Fin(0, 0)).Value = Deb(, 2).Value Deb.Resize(2).EntireRow.Delete Set Deb = Fin Set Fin = .FindNext(Fin) Loop Range(Deb(3, 0), .Cells(.Rows.Count)(1, 0)).Value = Deb(, 2).Value Deb.Resize(2).EntireRow.Delete .Offset(, -1).AutoFit End With Set Deb = Nothing: Set Fin = Nothing Me.Columns(3).ColumnWidth = Me.StandardWidth Application.ScreenUpdating = True End Sub
Pour l'intégrer dans un autre type de module, remplacer Me par un objet représentant la feuille (Feuil1, Worksheets) …

__________________________________________________________________________________________

Merci de cliquer sur :plusser: pour chaque message ayant aidé puis sur :resolu: pour clore cette discussion …

__________________________________________________________________________________________
Pour s'endormir, un mouton ne peut compter que sur lui-même …

22/12/2013, 10h02
jpvba65

Bonjour

Spookyz
La macro fonctionne au niveau de la suppression des lignes demandées.
Par contre le contenu de la cellule à droite des "blabla" n'est pas copiée dans
la colonne A.

Marc-L
La macro génère un beep et c'est tout.

J'ai modifié le tableau joint précédemment en intégrant les lettres de colonnes et les N° de lignes sur les tableaux avant et après.

Merci pour le temps que vous prenez pour m'aider.
22/12/2013, 10h16
spookyz

1 pièce(s) jointe(s)

Bonjour à tous ,
je te met le classeur sur lequel chez moi ça fonctionne
clic sur le bouton de la feuille test et dis moi
cordialement
22/12/2013, 12h54
Marc-L

Citation:

Envoyé par jpvba65

La macro génère un beep et c'est tout.

C'est le problème lorsque le classeur joint ne correspond pas aux données réelles ‼ :roll:

De mon côté elle fonctionne comme un charme …

Ou sinon tu n'as pas mis le code dans le module de la feuille comme pourtant indiqué noir sur blanc !
Avec de plus l'explication pour l'intégrer dans un autre type de module … :?

Sinon en lisant le code … le beep veut dire que la case C1 est vide donc il n'y a rien à traiter ‼ CQFD

Donc à tester avec une feuille ayant des données à traiter et avec la procédure au bon endroit …
22/12/2013, 18h25
jpvba65

Spookyz

Effectivement ton tableau fonctionne.
Et pourtant sur le mien je n'ai pas la copie des cellules. Je ne comprends pas.
J'essaye plein de chose mais en vain.
Au cas ou, je te donne plus de détail sur mon tableau:
J'utilise les colonnes A à N (la colonne A étant en attente du résultat de la macro). Les colonnes B à N sont remplies de texte.
Les cellules en dessous des "blabla" ne sont pas fusionnées (contrairement à mon tableau exemple)

J'utilise Office 2010.

Merci
22/12/2013, 18h45
Marc-L

Avec un classeur en pièce jointe (sans commentaire et ligne inutiles) réel, ce serait plus clair …
22/12/2013, 19h01
jpvba65

1 pièce(s) jointe(s)

Voilà en pièce jointe mon tableau réel.
Le texte de référence "blabla" est en réalité "Device"

Spookyz je précise que dans ta macro j'ai remplacé blabla par Device.

Merci

C'est bon chez moi, à insérer dans le module de la feuille :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Demo()
    Dim Deb As Range, Fin As Range
 
    If Me.[C1].Value = "" Then Beep: Exit Sub
    Application.ScreenUpdating = False
                       Set Deb = Me.[B1]
 
    With Deb.CurrentRegion.Columns(1)
        Set Fin = .Find(Deb.Value, , xlValues, xlWhole, , , True)
 
        Do Until Fin.Address = Deb.Address
            Range(Deb(3, 0), Fin(0, 0)).Value = Deb(, 2).Value
            Deb.Resize(2).EntireRow.Delete
            Set Deb = Fin
            Set Fin = .FindNext(Fin)
        Loop
 
        Range(Deb(3, 0), .Cells(.Rows.Count)(1, 0)).Value = Deb(, 2).Value
        Deb.Resize(2).EntireRow.Delete
    End With
                       Set Deb = Nothing:  Set Fin = Nothing
    Application.ScreenUpdating = True
End Sub

__________________________________________________________________________________________

Merci de cliquer sur :plusser: pour chaque message ayant aidé puis sur :resolu: pour clore cette discussion …

__________________________________________________________________________________________
Question bien formulée, solution assurée ! (Robert Durupt)

26/12/2013, 13h20
jpvba65

Bonjour

C'à y est enfin les deux macros fonctionnent sur mon PC (merci à spookyz et Marc-L)
Par contre la raison me laisse perplexe.
Dans chacune de mes tentatives je copiais une feuille (sauvegarde)
et je la collais dans ma feuille de test. J'ai fait de nombreux essais dans
cette configuration sans succès.
Pour que celà fonctionne j'ai retapé "Device" dans la première cellule
contenant ce texte, ensuite j'ai copié/collé cette cellule dans toute celles contenant "Device".
Et la miracle cela fonctionne.
Je suis totalement incapable d'expliquer pourquoi.

Petit détail suplémentaire une fois la macro finie les cellules sont plus hautes.
Je suis obligé d'aller dans Format de cellule/Alignement/ cocher puis décocher
Renvoyer à la ligne automatiquement pour retrouver mes hauteurs de ligne initiales.

Je déclare ma demande comme résolu car ce que je recherchais est fonctionnel même si le pourquoi m'est inconnu.

Encore merci
26/12/2013, 13h35
Marc-L

Salut !

Et sans vote la prochaine fois tu resteras dans ton jus …
26/12/2013, 14h47
jpvba65

C'est à dire ????????

Tu profites de ta citation pour me traiter de con ???
26/12/2013, 16h13
Marc-L

Heu non, c'est ma citation par défaut comme tu aurais dû le voir dès mon premier message ‼

Le vote fait partie des règles de ce forum,
qui plus est clairement indiqué en bas de mes messages avec du code,
donc sans vote alors que tu profites d'une solution sur mesure,
juste ne pas s'étonner la prochaine fois de ne pas avoir de réponse …

Voir 40 message(s) de cette discussion en une page