Microsoft 365 Sélectionner des cellules

[bjtj]

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 :

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]

Bonjour bjtj, bienvenue sur XLD,

On peut faire un filtrage sur la couleur, en supposant que les cellules colorées sont en colonne A :

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]

Bonjour bjtj, bienvenue sur XLD,

On peut faire un filtrage sur la couleur, en supposant que les cellules colorées sont en colonne A :

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]

Il faut bien que je rajoute cela à la suite de mon code précédent ?

Oui ou dans une macro séparée c'est comme vous voulez.

 

[job75]

La macro précédente ne va pas bien si le filtre automatique est en place, il faut alors l'ôter :

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]

La macro précédente ne va pas bien si le filtre automatique est en place, il faut alors l'ôter :

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

 

[job75]

Sachez qu'en VBA les Select sont en général inutiles, il faut les éviter.

Pour coller en Feuil2 il suffit d'écrire :

P.Copy Sheets("Feuil2").Cells(2, 1) 'colle en A2 de Feuil2 (adapter le nom de la feuille)

 

[bjtj]

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 ?

 

[job75]

Le nom feuille2 n'est pas génial puisque cette variable est un objet Range (une cellule ou une plage).

Et quand on définit un objet il faut utiliser l'instruction Set :

Set feuille2 = Sheets("Feuil2").Range("A1")