Collage sous condition particulier.

[karinette]

Collage sous condition particulière.

Bonjour au forum,
voila mon soucis, j'ai une macro qui me colle la valeur et la couleur d'une cellule dans une plage données.
Ma question est :
Serait il possible d'empecher la macro de fonctionner UNIQUEMENT sur les cellule qui ont les valeurs "F1", "GR8" et "TR" ... mais qu'elle fonctionne sur les autres ...
J'avoue que je suis perdue ....

J'ai mit le classeur, et voici la macro :

Sub test()
Dim plage As Range
Set plage = Intersect(Selection, Range("E1:I24"))
If Not Intersect(ActiveCell, Range("E1:I24")) Is Nothing Then
With plage.Interior
.ColorIndex = Range("BASE!C2").Value
.Pattern = xlSolid
End With
plage.Font.ColorIndex = 0
plage.Font.Bold = True
plage.FormulaR1C1 = Range("BASE!B2").Value
Else
MsgBox "Mauvaise plage de selection"
End If
End Sub

Merci

 

[Guest]

Re : Collage sous condition particulier.

Bonjour Karinette, le forum,

A tester, macro excluant les cellules dont les valeurs sont strictement égales à F1 ou GR8 ou TR.

Comme chaque cellule de la plage doit être parcourue pour être comparée, c'est plus long.

Sub test()
    Dim plage As Range, c As Range
    Set plage = Intersect(Selection, Range("E1:I24"))
    If Not Intersect(ActiveCell, Range("E1:I24")) Is Nothing Then
        For Each c In plage.Cells
            If c <> "F1" And c <> "GR8" And c <> "TR" Then
                With c
                    With .Interior                    'Interieur de la cellule
                        .ColorIndex = Range("BASE!C2").Value
                        .Pattern = xlSolid
                    End With
                    With .Font                        'Police
                        .ColorIndex = 0
                        .Bold = True
                    End With
                    .FormulaR1C1 = Range("BASE!B2").Value
                End With
            End If
        Next c
    Else
        MsgBox "Mauvaise plage de selection"
    End If
End Sub

A bientôt

 

[karinette]

Re : Collage sous condition particulier.

C'est excellent ...
Est ce que l'on peut l'adapter à un coller classique ????
Par exemple en selectionnant une plage, et en collant dans une autre plage ...
J'ai un classeur où cela me serait tres utile ...

Avec une macro du style :

Sub test()
Range("B1:F24").Select
Selection.Copy
Range("H1:L24").Select
ActiveSheet.Paste
End Sub

Si j'ai des cellules "F1", "GR8" et "TR", collage innactif .....

 

[Guest]

Re : Collage sous condition particulier.

bonjour,

tu fais quelque chose comme ceci:

Sub CopierCollerPlageB1F24()
    Dim plage As Range, c As Range
    Dim shDest As Worksheet
    Dim IncrementColonne As Long
    
    Set shDest = Sheets("Destination") 'Feuille de destination des cellules
    IncrementColonne = 6 '6 colonnes de décalage entre B et H
    Set plage = Intersect(Selection, Range("B1:F24"))
    If Not Intersect(ActiveCell, Range("B1:F24")) Is Nothing Then
        For Each c In plage.Cells
            If c <> "F1" And c <> "GR8" And c <> "TR" Then
               c.Copy shDest.Cells(c.Row, c.Column + IncrementColonne)
            End If
        Next c
    Else
        MsgBox "Mauvaise plage de selection"
    End If
End Sub

A+