Microsoft 365 Sélection multiple sur une colonne et copie-collage

[bonoboas]

Bonjour la communauté,

Je me permets de vous solliciter pour une demande d'aide en VBA, comme le copiage en sélection multiple n'est pas possible, je souhaiterais à l'aide de la macro ci-dessous copier uniquement les cellules de couleur de la colonne (activecell). Merci d'avance pour votre aide.

Sub selectionCelluleParCouleur()

    Dim couleur As Long
    couleur = ActiveCell.Interior.Color

  Dim plage As Range
    Set plage = ActiveCell                            ' 1

    For Each c In ActiveSheet.UsedRange                ' 2
        If c.Interior.Color = couleur Then             ' 3
            Set plage = Application.Union(plage, c)    ' 4
        End If
    Next

    plage.Select

End Sub

 

[sylvanu]

Bonjour Bonoboas,
Pour copier la plage, il suffit de remplacer plage.select par plage.Copy.

Sub selectionCelluleParCouleur()

    Dim couleur As Long
    couleur = ActiveCell.Interior.Color

  Dim plage As Range
    Set plage = ActiveCell                            ' 1

    For Each c In ActiveSheet.UsedRange                ' 2
        If c.Interior.Color = couleur Then             ' 3
            Set plage = Application.Union(plage, c)    ' 4
        End If
    Next

    plage.Copy

' Collage pour exemple
[I4].PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub

 

[bonoboas]

Merci sylvanu
Mais je souhaiterais que la plage ne sélectionne que la colonne

 

[sylvanu]

Re,
Essayer de mettre un fichier exemple, ce sera plus clair;

 

[bonoboas]

Voici un fichier d'exemple avec des explications

 

[bonoboas]

Comme le copie-colle de sélection sur plusieurs colonnes n'est pas possible, je pense répéter la macro sur chaque colonne. En attendant d'avoir une autre idée

 

[sylvanu]

Une solution : On ne traite la cellule que si bonne couleur ET bonne colonne

Sub selectionCelluleParCouleurcopier()

    Dim couleur As Long
    couleur = ActiveCell.Interior.Color
    Dim plage As Range
    Set plage = ActiveCell                            ' 1
    Colonne = ActiveCell.Column     ' On mémorise le N°  de colonne de la cellule active
    For Each c In ActiveSheet.UsedRange                ' 2
        ' On ne traite la cellule que si bonne couleur ET bonne colonne
        If c.Interior.Color = couleur And c.Column = Colonne Then           ' 3
            Set plage = Application.Union(plage, c)    ' 4
        End If
    Next
    plage.Copy
    
' Collage pour exemple
[K1].PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub

 

[bonoboas]

Merci beaucoup Sylvanu, c'est presque le résultat attendu.
Est-ce-qu'il est possible de respecter les espacements entre les cellules?
En fait, le fondement de cette macro est de mettre à jour une feuille de calcul avec des variables en couleur jaune et des formules sur d'autres cellules. Et ensuite faire copier les variables (cellule en jaune) et les copier sur un autre classeur ayant la même disposition. Je laisse un fichier joint comme exemple plus concret. Merci beaucoup de votre aide.
PS : le copiage brut pourrait fonctionner mais il ne faut pas écraser les formules.

 

[sylvanu]

C'était pas très explicite.
Dans ce cas, vous pouvez faire plus simple :

Sub selectionCelluleParCouleurcopier()
    Dim couleur As Long
    couleur = ActiveCell.Interior.Color
    Dim plage As Range
    Set plage = ActiveCell
    For Each c In ActiveSheet.UsedRange
        If c.Interior.Color = couleur Then
            Colonne = c.Column
            Ligne = c.Row
            [ZoneColler].Cells(Ligne, Colonne) = c
        End If
    Next
End Sub

J'ai appelé ZoneColler l'ensemble de la feuille Collage

 

[patricktoulon]

bonjour

1. cet autre classeur est il ouvert?
2. le nom du sheet de reception inconnu!!???
3. cela doit il se faire automatiquement lors du click sur le bouton??
4. ou est ce toi qui décide avec click droit sur autre classeur??

une question bien posé génère des réponses plus précises

 

[bonoboas]

Bonjour Patrick,
1. le classeur est ouvert
2. le nom du sheet est le même
3. Sylvain solutionne mon problème. Voici la manip : j'ouvre le dernier classeur (mis à jour), j’insère une feuille vierge, je copie colle en valeur et en format les données de l'ancien classeur sur cette feuille, je fais tourner la macro de Sylvanu, et enfin je supprime la feuille.
Je pense que la manipulation assez simple et sûr. Mais je reste ouvert à d'autres solutions.
Merci Sylvain pour votre aide.