XL 2010 je cherche a extraire les valeurs des celules

[samoooo]

je cherche a extraire les valeurs des cellules couleur vert
et les cellules nos colleur
comme j ai fait manuellement
et merci

 

[Compte Supprimé 979]

Et le BONJOUR

 

[JHA]

Bonjour à tous,

Avec des colonnes supplémentaires.

JHA

 

[samoooo]

merci beaucoup

JHA​

 

[job75]

Bonsoir samoooo, Bruno, JHA,

Voyez le fichier joint et cette macro dans le code de la feuille étudiée :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim n2%, n1%, coul&
Application.ScreenUpdating = False
With [V6]
    .CurrentRegion.Clear 'RAZ
    Set Target = Intersect(Target, UsedRange)
    If Target Is Nothing Then Exit Sub
    For Each Target In Target
        If CStr(Target) <> "" Then
            coul = Target.DisplayFormat.Interior.Color
            If coul = vbWhite Then
                n2 = n2 + 1
                .Cells(2, n2) = Target
            Else
                n1 = n1 + 1
                With .Cells(1, n1)
                    .Value = Target
                    .Interior.Color = coul
                    .Font.Color = Target.DisplayFormat.Font.Color
                End With
            End If
        End If
    Next
    .CurrentRegion.HorizontalAlignment = xlCenter 'centrage
End With
End Sub

Elle se déclenche quand on sélectionne une plage queiconque

DisplayFormat existe depuis Excel 2007 et récupère tout format y compris ceux des MFC.

Bonne nuit.

 

[samoooo]

merci aussi a

job75​

tres bonne aidé !!!
si on peux gader resultats de la partie a etudié a partire de la celulle V6

 

[job75]

Bonjour samoooo, le forum,

si on peux gader resultats de la partie a etudié a partire de la celulle V6

Avec ce fichier (2) le résultat en V6 est stocké vers le bas par la touche <Entrée> :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim v, n2%, n1%, coul&
Application.ScreenUpdating = False
With [V6]
    .CurrentRegion.Clear 'RAZ
    Set Target = Intersect(Target, UsedRange)
    If Target Is Nothing Then Exit Sub
    For Each Target In Target
        v = Trim(CStr(Target))
        If v <> "" Then
            coul = Target.DisplayFormat.Interior.Color
            If coul = vbWhite Then
                n2 = n2 + 1
                .Cells(2, n2) = v
            Else
                n1 = n1 + 1
                With .Cells(1, n1)
                    .Value = v
                    .Interior.Color = coul
                    .Font.Color = Target.DisplayFormat.Font.Color
                End With
            End If
        End If
    Next
    .CurrentRegion.HorizontalAlignment = xlCenter 'centrage
    If Application.CountA([V6:V7]) Then Application.OnKey "~", Me.CodeName & ".Entree"
End With
End Sub

Private Sub Entree()
If MsgBox("Stocker le résultat ?", vbYesNo) = vbYes Then _
    Range([V6], Cells(6, Columns.Count)).Resize(3).Insert
Application.OnKey "~" 'RAZ
End Sub

A+

 

[job75]

Ce fichier (3) fait la même chose mais avec le clic droit :

Dim flag As Boolean 'mémorise la variable

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim v, n2%, n1%, coul&
Application.ScreenUpdating = False
With [V6]
    .CurrentRegion.Clear 'RAZ
    Set Target = Intersect(Target, UsedRange)
    If Target Is Nothing Then Exit Sub
    For Each Target In Target
        v = Trim(CStr(Target))
        If v <> "" Then
            coul = Target.DisplayFormat.Interior.Color
            If coul = vbWhite Then
                n2 = n2 + 1
                .Cells(2, n2) = v
            Else
                n1 = n1 + 1
                With .Cells(1, n1)
                    .Value = v
                    .Interior.Color = coul
                    .Font.Color = Target.DisplayFormat.Font.Color
                End With
            End If
        End If
    Next
    .CurrentRegion.HorizontalAlignment = xlCenter 'centrage
    flag = True
End With
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not flag Then Exit Sub
Cancel = True
If MsgBox("Stocker le résultat ?", vbYesNo) = vbYes Then _
    Range([V6], Cells(6, Columns.Count)).Resize(3).Insert
flag = False 'RAZ
End Sub

 

[samoooo]

merci

job75 les deux font le job ​