Extraction de cellule selon le style

  • Initiateur de la discussion Initiateur de la discussion jeromecools
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

J

jeromecools

Guest
Bonjour,
Je voudrais faire une recherche de cellule selon le style et récupérer ces cellules dans une nouvelle feuille.
Qulqu'un pourrais m'aider avec une solution ?
Merci pour votre aide,
jerome
 
Re : Extraction de cellule selon le style

Hello Staple1600,

J'ai amélioré mon code, mais j'ai une erreur sur la création de nouvelle feuille pour mettre les données.

Worksheets.Add After:=Worksheets(Worksheets.Count)

Je ne comprend pas pourquoi ?

As-tu une idée

Code:
' Macro pour extraire les données contenue dans les cellules ColorIndex jaunes (6)
Sub ChoixDeLaCouleurDeFondPourExtration()
    'Déclarations
    Dim ChoixCouleur As Byte
    ChoixCouleur = InputBox("Quel est la couleur de fond pour l'extract", "Choix d'une coulleur", 6)
    ExtraireLesDonneesDesCelluleDeCouleurs (ChoixCouleur)
End Sub

Function ExtraireLesDonneesDesCelluleDeCouleurs(ChoixCouleur As Byte)
    'Déclarations
    Dim c As Range, i As Long, s_tr As String, t As Variant
    'On parcourt chaque cellule de la zone active
    For Each c In ActiveSheet.UsedRange
        If c.Interior.ColorIndex = ChoixCouleur Then
            s_tr = s_tr & c.Text & vbTab
            'alors on concatène la "valeur" de la cellule dans une chaine
        End If
    Next c
    'On transforme cette chaine en tableau (array)
    t = Split(s_tr, vbTab)
    'On cree une nouvelle feuille après les autres existante
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    'On recopie les données dans une colonne
    ActiveSheet.[A1].Resize(UBound(t)) = Application.Transpose(t)
End Function
 
Re : Extraction de cellule selon le style

Bonsoir jeromecools

As-tu une idée?
Oui.
Comme ceci, cela fonctionne.
Code:
Public ChoixCouleur As Long
Sub ChoixDeLaCouleurDeFondPourExtration()
    ChoixCouleur = InputBox("Quel est la couleur de fond pour l'extract", "Choix d'une coulleur", 6)
    ExtraireLesDonneesDesCelluleDeCouleurs (ChoixCouleur)
End Sub

Sub ExtraireLesDonneesDesCelluleDeCouleurs(ChoixCouleur)
    Dim c As Range, s_tr$, t
    For Each c In ActiveSheet.UsedRange
        If c.Interior.ColorIndex = ChoixCouleur Then
            s_tr = s_tr & c.Text & vbTab
        End If
    Next c
    t = Split(s_tr, vbTab)
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.[A1].Resize(UBound(t)) = Application.Transpose(t)
End Sub
PS: j'eusse écris "J'ai amélioré "notre" code" 🙄
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
7
Affichages
675
Réponses
2
Affichages
239
Réponses
2
Affichages
141
Retour