Empêcher copie de cellules dans cellules colorées

[Lio59]

Bonjour et soir... ou matin...

Je souhaite copier une plage de cellules (en ligne) de la feuil1 sur d'autres feuilles du classeur via une listbox

Si les cellules, recevant la copie, sont de blanches, alors pas de problèmes. En revanche, si au moins une seule cellule recevant la copie des cellules sélectionnées en Feuil1 est colorées (différentes couleurs peuvent être présentes , sauf le blanc), alors
MsgBox "Une ou toute la plage est déjà occupée!"

Dim I as Single
Dim NbCellule as Single
Dim Selecoul as Range

I = ActiveCell.Row 'I prend la valeur du num de ligne de la cel active
NbCellule = Selection.Columns.Count  'compte le nombre de cellules

With ListBox1 'Ds la lisbox s'affiche les feuilles à sélectionner pour la copie

For Selecsem = 0 To .ListCount - 1 'Sélection des feuilles
If ListBox1.ListIndex = -1 Then Exit Sub 'Si aucune feuille n'est sélectionnée
If .Selected(Selecsem) = True Then 'Si il y a une sélection
Sheets(.List(Selecsem)).Select
Plage.Copy Range(Plage.Address) 'Copie de la plage sélectionnée
Range(Plage.Address).Interior.ColorIndex = Range("B" & I).Interior.ColorIndex
'Copie de la couleur 

'c'est là où je n'arrive pas à trouver la solution...

Set selecoul = Range(Cells(I, 4), Cells(I, 27))

If Range(Plage.Address).Interior.ColorIndex <> Intersect(selcoul, Selection).Interior.ColorIndex Then
MsgBox "La plage superpose une plage  existante!"
Exit Sub
End If

Si vous avez une idée.. merci à tous!
Lio

 

[Robert]

Re : Empêcher copie de cellules dans cellules colorées

Bonjour Lio, bonjour le forum,

Ton code n'est pas complet il manque un End If, un Next Selecsem et un End With. Mais ça c'est pas bien grave...
Ce que je ne comprends pas c'est :

Plage.Copy Range(Plage.Address) 'Copie de la plage sélectionnée
Range(Plage.Address).Interior.ColorIndex = Range("B" & I).Interior.ColorIndex

la variable Plage n'est ni déclarée ni définie nulle part ??? En fait pour pouvoir t'aider il faudrait d'abord que je comprenne...

Édition :
peut-être comme ça (non testé) :

Sub Macro1()
Dim plage As Range 'déclare la variable plage
Dim col As Byte 'déclare la variable col (COLonnes)
Dim li As Integer 'déclare la variable li (LIgnes)
Dim ad As String 'déclare la variable ad (ADresse)
Dim dest As Range 'déclare la variable dest (DESTination)
 
Set plage = Selection 'définit la variable plage
col = plage.Columns.Count 'définit la variable col
li = plage.Rows.Count 'définit la variable li
ad = ActiveCell.Address 'définit la variable ad
 
With ListBox1 'Ds la lisbox s'affiche les feuilles à sélectionner pour la copie
    For selecsem = 0 To .ListCount - 1 'Sélection des feuilles
        If ListBox1.ListIndex = -1 Then Exit Sub 'Si aucune feuille n'est sélectionnée
        If .Selected(selecsem) = True Then 'Condition 1 : Si il y a une sélection
            Sheets(.List(selecsem)).Select
            Set dest = Range(ad) 'définit la variable dest
            For Each cel In Range(dest, dest.Offset(li, col)) 'boucle sur toutes les cellules de la plage
                If cel.Interior.ColorIndex <> xlNone Then 'Condition 2 : si la cellule est colorée
                    MsgBox "Une ou toute la plage est déjà occupée!" 'message
                    Exit Sub 'sort de la procédure
                End If 'fin de la condition 2
            Next cel 'prochaine cellule de la plage
            plage.Copy dest 'copie et colle la plage
        End If 'fin de la condition 1
    Next selecsem 'prochain item de la ListBox1
End With
End Sub

 

[Lio59]

Re : Empêcher copie de cellules dans cellules colorées

Merci Robert!

Alors oui j'ai oublié end if, next selecsem et end with. J'ai fait un copier/coller de mon code, ai supprimé quelques lignes afin de rendre le code un peu moins abscon!

Après quelques modifications de variables et un petit ajustement, votre aide m'a été précieuse.
J'entends par ajustement :
Si une sélection touche une sélection existante, le message me signalant une superposition s'affichait. Il fallait juste supprimer .offset(Li,Col)
Merci!

Dans mon post je n'ai pas pris en compte une autre possibilité d'erreur (du même ordre), c'est pourquoi il me semble pouvoir rester sur ce post.

en colonne B j'ai des listes déroulantes qui reprennent des noms avec pour chaque nom une couleur.
C'est justement cette couleur qui doit être reportée dans chaque sélection des feuilles sélectionnées (listbox). Cela fonctionne

Imaginons le cas suivant

Je sélectionne le nom "dédé" et "4 cellules" pour les feuilles 2 et 4, valide, tt va bien
ensuite,
je sélectionne le nom "bouboule" et "2 cellules" pour les feuilles 3 et 4.
La feuille 4 est donc commune à "dédé" et "bouboule"
La sélection des 2 cellules de "bouboule" ne se superpose pas avec les cellules colorées de "dédé"

Je doit donc tester ,AVANT la copie du "Nom" et de la sélection", sur chaque feuille la colonne B et voir s'il n'y a pas un nom donc une couleur différente avant de copier..


Cela ne fonctionne pas, alors comment tester chaque feuille?
J'utilise

For Each Sheets(.List(Selecsem)) In Sheets(.List(Selecsem)).Select
            If Range("B" & I).Interior.ColorIndex = xlNone Then

Quelle serait la syntaxe??
Cette manière me paraît plus efficace. Car si une erreur se produit, je souhaite
1. Faire une boucle de tests sur les feuilles sélectionnées
et si pas d'erreurs, je COPIE le NOM et la SELECTION
cela éviterait d'arrêtre le processus sur la feuille où se trouve l'erreur et donc devoir supprimer manuellement les sélection précédente...

Je suis dans ce pb depuis pas mal de temps et espère être assez clair... euh non... je ne crois pas!