Microsoft 365 Sélectionner des cellules

bjtj

XLDnaute Nouveau
Bonjour, je suis nouvelle sur le forum et je démarre en VBA.
Dans le cadre d'un projet, je souhaiterai couper-coller certaines cellules en fonction de leur mises en forme dans une autre colonne.
Dans ma colonne A, j'ai appliqué une mise en forme différente (avec une macro) qui met en évidence les doublons, ensuite je voudrais trouver une fonction automatique qui ne va sélectionner que les cellules en couleur (donc les doublons) pour que je puisse utiliser la fonction "Selection.cut" et ainsi coller les doublons dans la colonne B et les supprimer de la colonne A.
Voici le début de ma macro :
1613140107531.png

Objectif : trouver une formule qui sélectionne les cellules mises en couleur.
J'ai essayé avec If ou select case, mais cela ne fonctionne pas ça me colle toutes les cellules

J'espère avoir été claire et avoir bien respecter les conditions du forum.

Merci par avance de votre aide.
 

job75

XLDnaute Barbatruc
Bonjour bjtj, bienvenue sur XLD,

On peut faire un filtrage sur la couleur, en supposant que les cellules colorées sont en colonne A :
VB:
Sub FiltreCouleur()
Dim P As Range
With ActiveSheet.UsedRange
    .Rows(1).EntireRow.Insert 'pour fonctionner même si la 1ère cellule est colorée
    Union(.Rows(0), .Cells).AutoFilter 1, RGB(255, 0, 32), Operator:=xlFilterCellColor 'filtre couleur
    On Error Resume Next 'si aucune SpecialCell
    Set P = .Columns(1).SpecialCells(xlCellTypeVisible)
    .Rows(0).EntireRow.Delete 'ôte le filtre en même temps
     P.Copy .Cells(2, 2) 'colle en B2
     'P.Clear 'efface
     P.Delete xlUp 'supprime
End With
End Sub
A+
 

bjtj

XLDnaute Nouveau
Bonjour bjtj, bienvenue sur XLD,

On peut faire un filtrage sur la couleur, en supposant que les cellules colorées sont en colonne A :
VB:
Sub FiltreCouleur()
Dim P As Range
With ActiveSheet.UsedRange
    .Rows(1).EntireRow.Insert 'pour fonctionner même si la 1ère cellule est colorée
    Union(.Rows(0), .Cells).AutoFilter 1, RGB(255, 0, 32), Operator:=xlFilterCellColor 'filtre couleur
    On Error Resume Next 'si aucune SpecialCell
    Set P = .Columns(1).SpecialCells(xlCellTypeVisible)
    .Rows(0).EntireRow.Delete 'ôte le filtre en même temps
     P.Copy .Cells(2, 2) 'colle en B2
     'P.Clear 'efface
     P.Delete xlUp 'supprime
End With
End Sub
A+
Bonjour, je vous remercie d'avoir pris le temps de me répondre, je vais de suite essayé si ça fonctionne. Il faut bien que je rajoute cela à la suite de mon code précédent ?

Merci de votre réponse.
 

job75

XLDnaute Barbatruc
La macro précédente ne va pas bien si le filtre automatique est en place, il faut alors l'ôter :
VB:
Sub FiltreCouleur()
Dim P As Range
With ActiveSheet.UsedRange
    .Parent.AutoFilterMode = False 'ôte le filtre s'il est en place
    .Rows(1).EntireRow.Insert 'pour fonctionner même si la 1ère cellule est colorée
    Union(.Rows(0), .Cells).AutoFilter 1, RGB(255, 0, 32), Operator:=xlFilterCellColor 'filtre couleur
    On Error Resume Next 'si aucune SpecialCell
    Set P = .Columns(1).SpecialCells(xlCellTypeVisible)
    .Rows(0).EntireRow.Delete 'ôte le filtre en même temps
     P.Copy .Cells(2, 2)
     'P.Clear 'efface
     P.Delete xlUp 'supprime
End With
End Sub
 

bjtj

XLDnaute Nouveau
La macro précédente ne va pas bien si le filtre automatique est en place, il faut alors l'ôter :
VB:
Sub FiltreCouleur()
Dim P As Range
With ActiveSheet.UsedRange
    .Parent.AutoFilterMode = False 'ôte le filtre s'il est en place
    .Rows(1).EntireRow.Insert 'pour fonctionner même si la 1ère cellule est colorée
    Union(.Rows(0), .Cells).AutoFilter 1, RGB(255, 0, 32), Operator:=xlFilterCellColor 'filtre couleur
    On Error Resume Next 'si aucune SpecialCell
    Set P = .Columns(1).SpecialCells(xlCellTypeVisible)
    .Rows(0).EntireRow.Delete 'ôte le filtre en même temps
     P.Copy .Cells(2, 2)
     'P.Clear 'efface
     P.Delete xlUp 'supprime
End With
End Sub
En attendant votre réponse j'ai essayé et j'ai copié votre code à la suite et cela fonctionne. Merci beaucoup pour votre aide.

Je voudrais effectuer la même opération mais cette fois en copiant les doublons dans la feuille 2, en cherchant sur internet j'ai vu que des fois on pouvait utiliser Sheets("Feuil2").Select, je l'ai donc rajouté juste avant " P.Copy .Cells(2, 2)" mais cela ne veux pas fonctionner. Auriez-vous un autre conseil à me donner s'il vous plait ?
Merci beaucoup pour votre aide
 

bjtj

XLDnaute Nouveau
D'accord je ne savais pas merci de votre conseil.
Juste une petite dernière question (et après je ne vous embête plus;))
Je voudrais appliquer une autre mise en forme que le rouge aux cellules collées dans la feuille 2, j'ai essayé avec ce que je connais mais cela ne fonctionne pas. Est-il possible de changer la mise en forme après le code que vous m'avez donné ?
Voilà ce que j'ai essayé :

feuille2 = Sheets("Feuil2").Range("A")
feuille2.Interior.Color = RGB(64, 224, 255)
feuille2.Font.Size = 11

Il y a surement une erreur ! Pourriez-vous m'expliquer comment faire s'il vous plait ?
 

Discussions similaires