Copier/coller uniquement les cellules avec une couleur de fond particulière

13doc-macro.xlsx (10.58 Ko)

Bonjour, alors voilà j'aimerais créer une macro mais je suis encore (très) débutant en VBA donc j'ai un peu de mal.

Pour vous expliquer, j'ai une feuille "Données" sur laquelle il y a 4 tableaux reprenant des codes de référence. Dans chaque tableau, le nombre de codes de référence est variable d'un mois à l'autre et certains codes ont un fonds jaune. J'ai également une feuille "Récap" où il y a un tableau en 2 colonnes. Dans la première colonne de ce tableau, j'aimerais que la macro copie/colle les codes de référence sans fond jaune des tableaux 1, 2 et 3 de la feuille "Données" (les uns en dessous des autres, sachant que leur nombre est variable). Dans la 2e colonne du tableau "Récap", j'aimerais que la macro copie/colle les codes de référence du tableau 4 de la feuille "Données" n'ayant pas de fond jaune non plus. Ca fait un moment que je cherche une solution mais j'arrive pas à trouver.

Est-ce que quelqu'un aurait une solution svp ? J'ai mis le document excel, ce sera plus parlant je pense

Merci d'avance

bonjour Theo346, une proposition. Maintenant la dernière lignes des plages et 17, cela est aussi variable ?

Sub SansJaune()
     With Sheets("Données")
          For Each c In .Range("B3:B17,D3:D17,F3:F17,H3:H17").SpecialCells(xlConstants)
               If c.Interior.ColorIndex <> 6 Then
                    If c.Column <> 8 Then
                         s1 = s1 & "\" & c.Value
                    Else
                         s2 = s2 & "\" & c.Value
                    End If
               End If
          Next
     End With

     With Sheets("Récap")
          With .Range("B3:B16")
               .ClearContents
               sp = Split(Mid(s1, 2), "\")
               .Resize(Application.Min(.Rows.Count, UBound(sp) + 1)).Value = Application.Transpose(sp)
          End With

          With .Range("C3:C16")
               .ClearContents
               sp = Split(Mid(s2, 2), "\")
               .Resize(Application.Min(.Rows.Count, UBound(sp) + 1)).Value = Application.Transpose(sp)
          End With
     End With
End Sub

Merci beaucoup, c'est exactement ce que je cherchais à faire !

Effectivement il peut y avoir plus de 17 lignes dans les tableaux de la feuille "données". Est-ce qu'il y aurait un moyen d'intégrer ça dans la macro ? Sinon je peux simplement remplacer les plages de données types B3:B17 par B3:B1000 pour être très large sur le nombre de lignes. Mais par curiosité (et pour apprendre) j'aimerais bien en profiter pour savoir s'il y a un moyen de modifier cette macro pour avoir un nombre de lignes "infini"

re,

comme ceci ?

Sub SansJaune()
     Dim UN    As Range
     With Sheets("Données")
          For Each cell In Array("B3", "D3", "F3", "H3")
               Set c = .Range(cell)
               derligne = Application.Max(3, c.Offset(Rows.Count - c.Row).End(xlUp).Row)     'derniere cellule non vide à  partir de la 3ième ligne
               Set UN = Union(IIf(UN Is Nothing, c, UN), c.Resize(derligne - 2))
          Next
          MsgBox UN.Address
          If WorksheetFunction.CountA(UN) = 0 Then MsgBox "tout est vide !!! ", vbExclamation: Exit Sub

          For Each c In UN.SpecialCells(xlConstants)
               If c.Interior.ColorIndex <> 6 Then
                    If c.Column <> 8 Then
......

Génial, merci beaucoup

Rechercher des sujets similaires à "copier coller uniquement couleur fond particuliere"