Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Copier selon couleur

Créer une discussion

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 !

S'inscrire

CelluleVide

XLDnaute Occasionnel
Bonjour,
La macro copie les cellules de la plage selectionnée a la suite de la liste en feuil "recap"
La couleur étant "en dur" dans la macro, Je voudrais pouvoir choisir cette couleur avec la palette Excel ou un Userform qui aurait les différentes couleurs de la plage choisie.

D'autre part, quand on prend une plage assez large, la macro rame un peu. je pense que la syntaxe de la phase "collage" est a revoir.

Merci.
 

Pièces jointes

Trier par date Trier par votes
Re : Copier selon couleur

Bonjour CelluleVide,
Pour le UserForm je ne sais pas faire, pour la deuxième question (gagner du temps) je propose ceci:
Code: 
[COLOR=blue]Sub[/COLOR] Copier_selon_couleur()
[COLOR=blue]Dim[/COLOR] Derlign [COLOR=blue]As Long[/COLOR], Cel [COLOR=blue]As[/COLOR] Range, Couleur  [COLOR=blue]As Integer[/COLOR]
[COLOR=blue]Dim[/COLOR] Tablo()
Couleur = 34
k = 0
Application.ScreenUpdating = [COLOR=blue]False[/COLOR]
[COLOR=blue]ReDim[/COLOR] Tablo(k)
[COLOR=blue]For Each[/COLOR] Cel [COLOR=blue]In[/COLOR] Selection
    [COLOR=blue]If[/COLOR] Cel.Interior.ColorIndex = Couleur [COLOR=blue]Then[/COLOR]
        Tablo(k) = Cel.Value
        k = k + 1
        [COLOR=blue]ReDim Preserve[/COLOR] Tablo(k)
    [COLOR=blue]End If[/COLOR]
[COLOR=blue]Next[/COLOR] Cel
[COLOR=blue]If[/COLOR] k > 0 [COLOR=blue]Then[/COLOR]
    [COLOR=blue]With[/COLOR] Sheets("Recap")
        .Range("A" & .Range("A65536").End(xlUp).Offset(1, 0).Row).Resize([COLOR=blue]UBound[/COLOR](Tablo)) = Application.Transpose(Tablo)
    [COLOR=blue]End With[/COLOR]
[COLOR=blue]End If[/COLOR]
Application.ScreenUpdating = [COLOR=blue]True[/COLOR]
[COLOR=blue]End Sub[/COLOR]
Cordialement
 
Vote positif 0 Vote négatif
Re : Copier selon couleur

Re
Le code commenté:
Code: 
[COLOR=blue]Sub[/COLOR] Copier_selon_couleur()
[COLOR=blue]Dim[/COLOR] Derlign [COLOR=blue]As Long[/COLOR], Cel [COLOR=blue]As[/COLOR] Range, Couleur  [COLOR=blue]As Integer[/COLOR]
[COLOR=green]'Declaration d'un tableau vide[/COLOR]
[COLOR=blue]Dim[/COLOR] Tablo()
Couleur = 34
[COLOR=green]'Initialisation de la variable k (un tableau commence à 0)[/COLOR]
k = 0
Application.ScreenUpdating = [COLOR=blue]False[/COLOR]
[COLOR=green]'Redimentionnement du tableau pour créer la valeur 0[/COLOR]
[COLOR=blue]ReDim[/COLOR] Tablo(k)
[COLOR=blue]For Each[/COLOR] Cel [COLOR=blue]In[/COLOR] Selection
   [COLOR=green]'Si la couleur interieure de la cellule est = à la couleur[/COLOR]
    [COLOR=blue]If[/COLOR] Cel.Interior.ColorIndex = Couleur [COLOR=blue]Then[/COLOR]
       [COLOR=green]'La valeur (k) du tableau est égale à la valeur de la cellule[/COLOR]
        Tablo(k) = Cel.Value
       [COLOR=green]'on incrémente la variable k[/COLOR]
        k = k + 1
       [COLOR=green]''On agrandi le tableau en conservant les valeurs déja entrées[/COLOR]
        [COLOR=blue]ReDim Preserve[/COLOR] Tablo(k)
    [COLOR=blue]End If[/COLOR]
[COLOR=blue]Next[/COLOR] Cel
[COLOR=green]'Si le tableau n'est pas vide[/COLOR]
[COLOR=blue]If[/COLOR] k > 0 [COLOR=blue]Then[/COLOR]
    [COLOR=blue]With[/COLOR] Sheets("Recap")
       [COLOR=green]'On colle le tableau en A et dernière ligne[/COLOR]
[COLOR=green]      'Comme on utilise un tableau à une seule dimention[/COLOR]
[COLOR=green]      '(une seule ligne et plusieurs colonnes)[/COLOR]
[COLOR=green]      'il faut utiliser Application Transpose[/COLOR]
        .Range("A" & .Range("A65536").End(xlUp).Offset(1, 0).Row).Resize([COLOR=blue]UBound[/COLOR](Tablo)) = Application.Transpose(Tablo)
    [COLOR=blue]End With[/COLOR]
[COLOR=blue]End If[/COLOR]
Application.ScreenUpdating = [COLOR=blue]True[/COLOR]
[COLOR=blue]End Sub[/COLOR]
En espérant que c'est assez compréhensible...
Cordialement
 
Vote positif 0 Vote négatif
Re : Copier selon couleur

Ca y est!!! Fiat lux...

J'ai réussi a obtenir ce que je voulais:
La macro demande a l'utilisateur de choisir une couleur puis de selectionner la plage et copie les données en feuille recap.

Je poste le fichier résolu pour ceux que cela interesse...

Je n'aurais rien pu faire sans Efgé et les infos de ce forum magique

Merci aussi a Eric Renaud pour ces excellent didacticiels.
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Copier selon couleur

Re
Si je puis me permettre:
En selectionnant, dans l'exemple, de A2 à F15 et en choisissant une cellule "blanche", le résultat n'est pas vraiment celui attendu.
Pour remédier à ce petit défaut on peut remplacer:
Code: 
If Cel.Interior.ColorIndex = Couleur Then
Par
Code: 
If Cel.Interior.ColorIndex = Couleur And Cel.Value <> "" Then
Cordialement
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

Discussions similaires

  • Résolu(e)
XL 2021 Un BackColor selon un RAL connu
Réponses
11
Affichages
605
GGI
G
V
  • Résolu(e)
Microsoft 365 Macro pour sélectionner une plage de cellules selon une couleur de remplissage donnée
Réponses
2
Affichages
1 K
vash966
V
T
  • Résolu(e)
Microsoft 365 Thermomètre change de couleur selon le total d'une cellule
Réponses
12
Affichages
1 K
Taty 1973
T
C
  • Question Question
XL 2013 [vba] macro couleur cellules selon une liste
Réponses
10
Affichages
2 K
Dranreb
D
  • Question Question
XL 2013 Surlignement selon total a déduire
Réponses
0
Affichages
685
Doze3
D
L
  • Résolu(e)
XL 2019 Copier/Coller valeur + couleur d'un classeur à un autre
Réponses
7
Affichages
2 K
Etoto
  • Résolu(e)
Autres priorité MFC/macro
Réponses
11
Affichages
2 K
CISCO
R
  • Question Question
VBA ; recherche de valeurs mini sur une plage de façon dynamique
2 3
Réponses
30
Affichages
5 K
Raka
R
N
  • Question Question
XL 2010 VBA - Comparaison de cellules selon couleurs et autres joyeusetés
Réponses
12
Affichages
2 K
vgendron
H
  • Question Question
XL 2010 Copier couleur de fond et commentaire selon contenu de cellule
Réponses
1
Affichages
1 K
Jacky67
  • Question Question
XL 2010 Une fonction qui sature
Réponses
8
Affichages
2 K
Magic_Doctor
L
  • Question Question
définir la couleur d'une cellule selon le texte renseigné dans la dernière cellule non vide d'une pl
2
Réponses
16
Affichages
2 K
phlaurent55
J
  • Question Question
XL 2010 Problème de copier/coller
Réponses
1
Affichages
1 K
jfglrx
J
D
  • Question Question
XL 2010 Créer des onglets selon les infos filtrées d'une colonne
2
Réponses
17
Affichages
1 K
deps
D
F
  • Question Question
Graphique évolutif avec une base de données qui évolue
Réponses
5
Affichages
2 K
chris
Z
  • Question Question
Copier-Coller le contenu de cellule automatiquement
Réponses
0
Affichages
633
zac.dubeau
Z
L
  • Question Question
XL 2013 Remplissage auto couleur cellule sur onglet diiférent et selon onglet récap
Réponses
6
Affichages
954
Ludo58
L
D
  • Question Question
Copier Coller Cellule avec Validation en conservant la couleur
Réponses
11
Affichages
2 K
camarchepas
Z
  • Question Question
Trouver la couleur d'une MFC et l'afficher dans la Cellule d'à coté !
Réponses
11
Affichages
3 K
zephir94
Z
P
  • Question Question
Couleur dans cellule
Réponses
4
Affichages
901
ROGER2327
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…