Repérer les cellules de couleur violette

[lostheroe]

Bonjour,

J'aimerais créer une macro permettant de repérer les cellules de couleur violette, puis copier les valeurs contenues dans ces cellules pour ensuite les recopier dans ces dernières sans les liens.
Une fois l’opération effectuée changer la couleur des cellules pour les repasser en blanc.
Puis couper coller les colonnes de K à L dans une nouvelle feuille excel à sauvegarder dans le dossier ou est le placé le fichier source.
Et nommer ce nouveau fichier Tuy.

Cordialement

 

[Valentin_Loupe]

Re : Repérer les cellules de couleur violette

Bonjour Lostheroe, le forum,

Ci-joint, voici un fichier sensé reproduire textuellement ta demande.
Sous Module1, voir la procédure nommée "Opérations".

Option Explicit

Private Sub Opérations()

    Dim Cellule As Range
    Dim NouveauClasseur As Workbook

    'Pour chaque cellule utilisée dans la feuille 1
    For Each Cellule In Worksheets(Feuil1.Name).UsedRange

        'Si l'intérieur de la cellule utilisée est de couleur violette
        If Cellule.Interior.Color = 10642560 Then

            'Remplacer la valeur de cette cellule par sa valeur actuelle
            Cellule.Value = Cellule.Value

            'Retourner à un format de cellule sans remplissage
            Cellule.Interior.Pattern = xlNone

        End If

    Next

    'Création d'un nouveau classeur
    Set NouveauClasseur = Workbooks.Add

    'Couper les deux colonnes K et L dans la feuille source
    ThisWorkbook.Worksheets(Feuil1.Name).Range("K1:L1").EntireColumn.Cut

    'Coller les deux colonnes dans la feuille de destination
    NouveauClasseur.Worksheets(Feuil1.Name).Range("A1").Insert

    'Enregistrement du nouveau classeur dans le répertoire de l'actuel
    NouveauClasseur.SaveAs ThisWorkbook.Path & "\Tuy.xlsx"

    'Fermeture du nouveau classeur
    NouveauClasseur.Close

    'Libération de la mémoire
    Set NouveauClasseur = Nothing

    'Message de confirmation
    MsgBox "Exécution terminée avec succès !", vbInformation

End Sub

Bonne utilisation,

Cordialement,

Valentin

 

[ROGER2327]

Re : Repérer les cellules de couleur violette

Bonjour à tous.

Un autre code à placer dans un module standard.​

Sub tutu()
'À adapter à la situation réelle :
Const nFeuille_1$ = "Feuil1"  'Nom de l'onglet à traiter.
Const nPlage$ = "B3:L27"      'Adresse de la plage à traiter.
Const nColonnes = "K:L"       'Référence des colonnes à copier.
Const couleur = 10642560      'Couleur violette.
Const nFichier$ = "Tuy.xlsx"  'Nom du fichier à enregistrer
'dans le répertoire courant.
Const nFeuille_2$ = "XXX"     'Nom de la feuille dans le
                               'nouveau classeur.

'ATTENTION ! s'il existe un ancien fichier Tuy.xlsx dans le
'répertoire courant, il sera écrasé par le nouveau.

Dim cel As Range

  With ThisWorkbook.Worksheets(nFeuille_1)
    With .Range(nPlage)
      For Each cel In .Cells
        If cel.Interior.Color = couleur Then
          With cel
            .Interior.Color = xlNone
            .Value = .Value
          End With
        End If
      Next
    End With
    Application.ScreenUpdating = False
    .Parent.Sheets.Add
    .Columns(nColonnes).Cut Destination:=ActiveSheet.[A1]
  End With
  ActiveSheet.Move
  ActiveSheet.Name = nFeuille_2$
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs Filename:=CurDir & "\" & nFichier, _
    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
  Application.DisplayAlerts = True
  ActiveWindow.Close
End Sub

Bonne journée.


ℝOGER2327
#7896

Samedi 14 Merdre 142 (Saint Sphincter, profès - fête Suprême Quarte)
12 Prairial An CCXXIII, 0,2516h - bétoine
2015-W22-7T00:36:14Z

 

[lostheroe]

Re : Repérer les cellules de couleur violette

Bonjour,

Merci pour vos réponse.
J'aurais besoin de deux petites précisions. Concernant la macro je n'arrive pas à trouver le code couleur correspondant au violet de la feuille jointe.
Et concernant l'onglet du fichier jointe "idée", je n'arrive pas à changer ce nom dans la macro (en lieu et place de Feuil1.Name).

 

[ROGER2327]

Re : Repérer les cellules de couleur violette

Re...

(...) je n'arrive pas à trouver le code couleur correspondant au violet de la feuille jointe.
(...)

Sélectionnez une cellule dont vous voulez connaître la couleur de fond et exécutez cette procédure :​

Sub toto()
  MsgBox Selection(1).Interior.Color
End Sub

(...)
Et concernant l'onglet du fichier jointe "idée", je n'arrive pas à changer ce nom dans la macro (en lieu et place de Feuil1.Name).

D'où l'intérêt de regrouper les paramètres en tête de procédure comme je vous le proposais :​

Sub tutu()
'À adapter à la situation réelle :
Const nFeuille_1$ = "Feuil1"  'Nom de l'onglet à traiter.
Const nPlage$ = "B3:L27"      'Adresse de la plage à traiter.
Const nColonnes = "K:L"       'Référence des colonnes à copier.
Const couleur = 10642560      'Couleur violette.
Const nFichier$ = "Tuy.xlsx"  'Nom du fichier à enregistrer
'dans le répertoire courant.
Const nFeuille_2$ = "XXX"     'Nom de la feuille dans le
                               'nouveau classeur.

'ATTENTION ! s'il existe un ancien fichier Tuy.xlsx dans le
'répertoire courant, il sera écrasé par le nouveau.

'etc.
End Sub

Il vous aurait alors suffi de remplacer​

Const nFeuille_1$ = "Feuil1"  'Nom de l'onglet à traiter.

par​

Const nFeuille_1$ = "idée"  'Nom de l'onglet à traiter.

sans rien changer ailleurs. Mais vous êtes parfaitement libre de choisir une solution compliquée nécessitant des modifications à de multiples endroits.​

Bonne journée.


ℝOGER2327
#7899

Dimanche 15 Merdre 142 (Saints Serpents d’Airain - fête Suprême Tierce)
13 Prairial An CCXXIII, 6,0921h - pois
2015-W23-1T14:37:15Z

 

[lostheroe]

Re : Repérer les cellules de couleur violette

Votre solution me vas très bien.
Par contre la macro ne marche pas. La feuille excel plante à chaque fois que l'on active la macro

 

[herve62]

Re : Repérer les cellules de couleur violette

Bonsoir
Tout cela me semble complexe !
les codes couleurs , je les joins ( les autres , bizarre ? )
Si il n'y a pas de MFC voilà ce qu'il faut faire ( à adapter dans ton appli)

With Worksheets(1)

lastlig = .Range("A65000").End(xlUp).Row ' recherche derniere ligne en colonne A
For X = 3 To lastlig
    For y = 2 To 6
    Ad = .Cells(X, y).Address(0, 0)         ' coordonnée de la cellule Lue
   
Colo = .Cells(X, y).FormatConditions(1).Interior.ColorIndex

  ' Colo = .Cells(X, y).Interior.ColorIndex
    'coul = .Cells(X, y).PatternColor
    '.Pattern = xlSolid
   ' .PatternColorIndex = xlAutomatic
 ' donne la couleur de fond

        If Colo = 36 Then ' jaune=36
        Range("H" & X).Value = Range("H" & X).Value + 1
        
        End If
        If Colo = 35 Then ' vert=35
        Range("I" & X).Value = Range("I" & X).Value + 1
        End If
        If Colo = 37 Then ' Bleu ciel=37
        Range("J" & X).Value = Range("J" & X).Value + 1
        End If
        If Colo = 40 Then ' Orange=40
        Range("K" & X).Value = Range("K" & X).Value + 1
        End If
    Next y
Next X

End With

Surtout au niveau de la plage des X Y !
Pour le plantage : déjà j'ai vu 2 noms de SUB ??? s'enchainer pour le bouton
ensuite je pense qu'il faut incorporer le code que je laisse !

 

[herve62]

Re : Repérer les cellules de couleur violette

Yups !! oubli du fichier de la palette de couleurs pour le VBA
les codes sont simples , et pas des 1250... etc ???
Sinon ATTENTION si MFC , là ça marche plus , il faut une routine adaptée

 

[ROGER2327]

Re : Repérer les cellules de couleur violette

Re...

Votre solution me vas très bien.
Par contre la macro ne marche pas. La feuille excel plante à chaque fois que l'on active la macro

La procédure fonctionne à conditions que vous ne la modifiez pas en ajoutant Private Sub Opérations() !
Mais, puisque vous avez changé de problème, elle est très-lente : ce que j'ai écrit est convenable tant qu'il s'agit de traiter une plage de dimension raisonnable.
Vous parlez maintenant de traiter près de trente-six millions de cellules (colonnes P:AW). Bien qu'elles soient vides, il faut environ dix minutes pour les explorer.
Il serait temps que vous posiez votre véritable problème. Personnellement, je ne vois pas bien l'intérêt de traiter une immense plage de cellules vides.

En attendant, voici une version un peu améliorée au cas où il s'agit réellement de traiter des dizaines de colonnes entières.​

Bonne nuit.


ℝOGER2327
#7900

Dimanche 15 Merdre 142 (Saints Serpents d’Airain - fête Suprême Tierce)
13 Prairial An CCXXIII, 9,3889h - pois
2015-W23-1T22:32:00Z