Discussion :

[jpvba65]

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

[spookyz]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[nibledispo]

bonjour,

toto est certainement colonne B. Dans ce cas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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 …

[jpvba65]

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

[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 …

[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

[spookyz]

Bonsoir,
essaye ça peut être

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Marc-L]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 pour chaque message ayant aidé puis sur pour clore cette discussion …

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

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

[spookyz]

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

[Marc-L]

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 ‼

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 …

[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