Sélectionner et déplacer les cellules qui contiennent la valeur en C1

Bonjour à toutes et à tous,

Je vous souhaite un beau dimanche :)

J'ai récupéré dans le site un code : https://forum.excel-pratique.com/excel/selection-de-toutes-les-lignes-contenant-un-mot-106127

qui m'intéresse beaucoup mais je n'arrive pas à l'adapter.

Voici mon besoin :
- Ma colonne A est vide,
- sélectionner toutes les cellules qui contiennent "C1",
- les déplacer en G à partir de G2,
- supprimer les lignes vides.

Pourriez-vous m'aider ?

Je mets le fichier test en pièce jointe,

Avec mes remerciements,

Amicalement,

lionel,

4deplace-test.zip (615.64 Ko)

Bonjour,

Comme ceci ?

Option Compare Text
Sub ExtraitLignesMot()
With Worksheets("Conforme")
    mot = "*" & .[C1] & "*"
    bd = .Range("A2:F" & .[B65000].End(xlUp).Row)
    For i = 2 To UBound(bd)
        If bd(i, 2) Like mot Then temp = temp & i & ","
    Next i
    a = Application.Index(bd, Application.Transpose(Split(temp, ",")), 2)
    .Cells(2, 7).Resize(UBound(a) - 1, UBound(a, 2)) = a
End With
End Sub

Cdlt,

Bonjour,

je te remercie pour ce retour si rapide.

Je teste chez moi et je reviens te dire

lionel,

Re-Bonjour et un grand merci, ça fonctionne très bien.

Il me manque juste une chose :

Vider les cellules de la colonne "B" qui ont été copiées en F

et supprimer les cellules de la colonne "B" devenues vides.

Je cherche de mon côté,

lionel

Bonjour,

En passant par deux arrays :

Option Compare Text
Sub ExtraitLignesMot()
With Worksheets("Conforme")
    mot = "*" & .[C1] & "*"
    bd = .Range("A2:F" & .[B65000].End(xlUp).Row)
    For i = 2 To UBound(bd)
        If bd(i, 2) Like mot Then
            temp_g = temp_g & i & ","
            Else
            temp_b = temp_b & i & ","
        End If
    Next i
    .Range(.[B2], .[B2].End(xlDown)).ClearContents
    g = Application.Index(bd, Application.Transpose(Split(temp_g, ",")), 2)
    .Cells(2, 7).Resize(UBound(g) - 1, UBound(g, 2)) = g
    b = Application.Index(bd, Application.Transpose(Split(temp_b, ",")), 2)
    .Cells(2, 2).Resize(UBound(b) - 1, UBound(b, 2)) = b
End With
End Sub

Cdlt,

Re-Bonjour,

Je te remercie vraiment de t'intéresser à mon besoin et d'y passer du temps.

La dernière modif du code fonctionne bien mais il y a une ligne qui n'est pas déplacée et qui disparaît :

sans titre

Je cherche pourquoi et je t'envoie le fichier test :

3communes-test.zip (929.47 Ko)

Encore merci à toi,

lionel

Bonjour,

Petite erreur de ma part sur l'incrément de la boucle désolé. J'en ai profité pour rajouter une gestion d'erreur dans le cas où aucune commune ne correspond au critère :

Sub ExtraitLignesMot()
With Worksheets("Conforme")
    mot = "*" & .[C1] & "*"
    bd = .Range("A2:F" & .[B65000].End(xlUp).Row)
    For i = 1 To UBound(bd)
        If bd(i, 2) Like mot Then
            temp_g = temp_g & i & ","
            Else
            temp_b = temp_b & i & ","
        End If
    Next i
    .Range(.[b2], .[b2].End(xlDown)).ClearContents
    If Not IsEmpty(temp_g) Then
        g = Application.Index(bd, Application.Transpose(Split(temp_g, ",")), 2)
        .Cells(2, 6).Resize(UBound(g) - 1, UBound(g, 2)) = g
    End If
    If Not IsEmpty(temp_b) Then
        b = Application.Index(bd, Application.Transpose(Split(temp_b, ",")), 2)
        .Cells(2, 2).Resize(UBound(b) - 1, UBound(b, 2)) = b
    End If
End With
End Sub

Cdlt,

Re bonjour,

C'est nickel,

Je te remercie pour le temps que tu m'as consacré ... vraiment bien,

Merci,

lionel

Rechercher des sujets similaires à "selectionner deplacer qui contiennent valeur"