Sujet Précédent Sujet Suivant

VBA code pour extraire cellules ou le texte est coloré

Matzic - Modifié le 29 avril 2021 à 19:32
f894009 Messages postés 16935 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 31 mai 2023 - 1 mai 2021 à 08:57
Bonjour à tous et à toute,

Je me permets d'écrire ici car malgré mes recherches je ne parviens pas à termine mon code… il faut savoir que je débute aha
Je veux extraire les cellules d'un cellules oule texte est en couleur (rouge) d'un tableau à un autre dans la même feuille.
Je vous mets les codes que j'ai débuté 
 

Sub MAJ_Premium1()

' Copier les valeurs en rouge présentent dans les tableauyx 1,2 et 3 dans le tableau "Premium" (=tableau avec éléments courants)

' Défini les variables et paramètres
    Dim derniere_ligne As Integer
    Dim i As Integer
    Dim j As Integer
    Dim l As Integer
    
    l = 2
    derniere = Range("Recueil!A1" & i).End(xlDown).Row
    
' Boucles pour trouver les valeurs en rouge dans les tableaux + reporter dans tabl premium
    For i = 2 To derniere
        If Range("Recueil!A" & i).Font.ColorIndex = 3 Then ' ou <> 1
            k = 52
            For j = 1 To 11
                Sheets("Recueil").Cells(i, j).Value = Sheets("Recueil").Cells(j + 51, l).Value
             
            Next
            
           l = l + 1
        
        
        End If
    Next
  MsgBox ("test")


et le deuxième 

Sub MAJ_Premium()

' Copier les valeurs en rouge présentent dans les tableauyx 1,2 et 3 dans le tableau "Premium" (=tableau avec éléments courants)

' Défini les variables et paramètres
    Dim derniere_ligne As Integer
    Dim i As Integer
    Dim j As Integer
    Dim l As Integer
    Dim k As Integer
    l = 2
    derniere = Range("Recueil!A1" & i).End(xlDown).Row
    
' Boucles pour trouver les valeurs en rouge dans les tableaux + reporter dans tabl premium
    For i = 2 To derniere
        If Range("Recueil!A" & i).Font.ColorIndex = 3 Then ' ou <> 1
            k = 52

            For j = 1 To 11
                Sheets("Recueil").Cells(j, i).Value = Sheets("Recueil").Cells(k, l).Value
              k = k + 1
            Next
            
           l = l + 1
        
        
        End If
    Next
  MsgBox ("test")
  
End Sub


Si quelqu'un peut m'aider ça serait top, je suis ouvert à d'autres solutions!

Merci d'avance

1 réponse

Réponse 1 / 1
f894009 Messages postés 16935 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 31 mai 2023 2
Modifié le 1 mai 2021 à 08:58
Bonjour,

Copie en ligne 
Sub MAJ_Premium1()
' Copier les valeurs en rouge présentent dans les tableauyx 1,2 et 3 dans le tableau "Premium" (=tableau avec éléments courants)
' Défini les variables et paramètres
    Dim derniere_ligne As Long
    Dim i As Long
    Dim j As Long
    Dim k As Long
    
    With Worksheets("Recueil")
        derniere_ligne = .Range("A" & .Rows.Count).End(xlUp).Row
    ' Boucles pour trouver les valeurs en rouge dans les tableaux + reporter dans tabl premium
        k = 52
        For i = 2 To derniere_ligne
            If .Range("A" & i).Font.ColorIndex = 3 Then ' ou <> 1
                For j = 2 To 11    'si 1 ald vous ecrasez la colonne A?????
                    .Cells(i, j).Value = .Cells(k, j).Value
                Next
               k = k + 1
            End If
        Next
    End With
    MsgBox ("test")
End Sub


Le deuxieme est une copie en colonne, a y un probleme?
0
Rejoignez-nous