erreur sur elaboration d un code

Bonjour,

j'obtiend ce message d'erreur : erreur de compilation:
nombre d'arguments incorrect ou affectation de propriété incorrecte

et sur le code, l' erreur se positionne sur RANGE( au niveau de "Départs
ACT" Et Apparemment,le 1er FOR EACH sur("Taux de siren") a bien passé..

Par contre sur le 2eme FOR EACH sur("Départs ACT") ne passe pas et bloque
a
ce niveau la..

For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then

l'erreur se positionne ici-------->RANGE(c.Offset(0, 1), c.Offset(0, 2),
c.Offset(0, 4), c.Offset(0, 5)).Select
pouvez vous resoudre ce probleme..je vous laisse ci joint le code en
question.

Merci de votre soutien

Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4), c.Offset(0,
5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) = "Nombre
de d'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant Moyen
Créance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c, 13)
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
Next s
Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
--


--
ALF

Bonjour

le nb d'argument est maxi 2
Que souhaites tu en finalité
J'ai corrigé le nb d'arguments
Essaie ceci

Sub a()
Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) = "Nombrede
d 'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant
MoyenCréance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c, 13)
_
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next

Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
End Sub

jp25

"ALF" <ALF@discussions.microsoft.com> a écrit dans le message de news:
749F86A7-7430-4277-9456-268414F1D9BB@microsoft.com...

Bonjour,

j'obtiend ce message d'erreur : erreur de compilation:
nombre d'arguments incorrect ou affectation de propriété incorrecte

et sur le code, l' erreur se positionne sur RANGE( au niveau de "Départs
ACT" Et Apparemment,le 1er FOR EACH sur("Taux de siren") a bien passé..

Par contre sur le 2eme FOR EACH sur("Départs ACT") ne passe pas et bloque
a
ce niveau la..

For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then

l'erreur se positionne ici-------->RANGE(c.Offset(0, 1), c.Offset(0, 2),
c.Offset(0, 4), c.Offset(0, 5)).Select
pouvez vous resoudre ce probleme..je vous laisse ci joint le code en
question.

Merci de votre soutien

Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4), c.Offset(0,
5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) = "Nombre
de d'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant Moyen
Créance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c, 13)
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
Next s
Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
--


--
ALF

Re,
et merci jp25 pour ta reponse..
le but de ce code est de selectionner certaines cellules qui sont à droite
de la cellule "Nom de l'indicateur",pour pouvoir les griser car ce sont
des
cellules qui n'auront jamais de valeurs..
c'est pourquoi,parfois il faut 3 ou 4 arguments à griser..
d'où le probleme car tu viens de me signaler qu'il ne peut y avoir que 2
arguments dans la fonction RANGE()...

y a t-il alors un autre moyen pour devier ce probleme ???

Merci encore pour votre soutien

--
ALF

Bonjour

le nb d'argument est maxi 2
Que souhaites tu en finalité
J'ai corrigé le nb d'arguments
Essaie ceci

Sub a()
Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) =
"Nombrede
d 'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant
MoyenCréance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c,
13)
_
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next

Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
End Sub

jp25

"ALF" <ALF@discussions.microsoft.com> a écrit dans le message de news:
749F86A7-7430-4277-9456-268414F1D9BB@microsoft.com...

Bonjour,

j'obtiend ce message d'erreur : erreur de compilation:
nombre d'arguments incorrect ou affectation de propriété incorrecte

et sur le code, l' erreur se positionne sur RANGE( au niveau de
"Départs
ACT" Et Apparemment,le 1er FOR EACH sur("Taux de siren") a bien passé..

Par contre sur le 2eme FOR EACH sur("Départs ACT") ne passe pas et
bloque
a
ce niveau la..

For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then

l'erreur se positionne ici-------->RANGE(c.Offset(0, 1), c.Offset(0,
2),
c.Offset(0, 4), c.Offset(0, 5)).Select
pouvez vous resoudre ce probleme..je vous laisse ci joint le code en
question.

Merci de votre soutien

Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4), c.Offset(0,
5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) =
"Nombre
de d'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant Moyen
Créance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c,
13)
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
Next s
Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
--


--
ALF

Re,
et merci jp25 pour ta reponse..
le but de ce code est de selectionner certaines cellules qui sont à droite
de la cellule "Nom de l'indicateur",pour pouvoir les griser car ce sont
des
cellules qui n'auront jamais de valeurs..
c'est pourquoi,parfois il faut 3 ou 4 arguments à griser..
d'où le probleme car tu viens de me signaler qu'il ne peut y avoir que 2
arguments dans la fonction RANGE()...

y a t-il alors un autre moyen pour devier ce probleme ???

Merci encore pour votre soutien

--
ALF

Bonjour

le nb d'argument est maxi 2
Que souhaites tu en finalité
J'ai corrigé le nb d'arguments
Essaie ceci

Sub a()
Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) =
"Nombrede
d 'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant
MoyenCréance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c,
13)
_
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next

Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
End Sub

jp25

"ALF" <ALF@discussions.microsoft.com> a écrit dans le message de news:
749F86A7-7430-4277-9456-268414F1D9BB@microsoft.com...

Bonjour,

j'obtiend ce message d'erreur : erreur de compilation:
nombre d'arguments incorrect ou affectation de propriété incorrecte

et sur le code, l' erreur se positionne sur RANGE( au niveau de
"Départs
ACT" Et Apparemment,le 1er FOR EACH sur("Taux de siren") a bien passé..

Par contre sur le 2eme FOR EACH sur("Départs ACT") ne passe pas et
bloque
a
ce niveau la..

For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then

l'erreur se positionne ici-------->RANGE(c.Offset(0, 1), c.Offset(0,
2),
c.Offset(0, 4), c.Offset(0, 5)).Select
pouvez vous resoudre ce probleme..je vous laisse ci joint le code en
question.

Merci de votre soutien

Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4), c.Offset(0,
5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) =
"Nombre
de d'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant Moyen
Créance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c,
13)
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
Next s
Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
--


--
ALF

For Each c In Range("B2:Q73")

*Bonjour ALF*,
Pour tes boucles, tu gagnerais en temps si tu faisais ta boucle seulement sur
la colonne B :
For Each c In Range("B2:B73")
En complement, je ferais plutot un select case pour tout faire dans la même
boucle au lieu d'en faire 6. 6 boucles= 6 fois plus long :/

For Each c In Range("B2:Q73")

Voici le code obtenu :-) : plus simple à maintenir et on voit mieux ce
que l'on fait, moins long car moins de boucles

Dim FeuilleActive As Worksheet
Dim Couleur As Variant
Dim Motif As Long
Dim CouleurMotif As Long
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:B73")
Select Case c
Case "Taux de siren"
Union(c.Offset(0, 3), c.Offset(0, 4)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case Is = "Départs ACT"
Union(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4), c.Offset(0,
5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Nombre de dossiers par ETP", "Nombre de d 'avis par ETP"
Union(c.Offset(0, 1), c.Offset(0, 4), c.Offset(0, 5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Montant du Stock", "Montant Moyen Créance", "Nombre Total de
dossiers en stock"
Union(c.Offset(0, 4), c.Offset(0, 5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Efficacité du recouvrement (sans ACI)", "Nombre d' ACI",
"Montant d' ACI"
c.Offset(0, 5).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Nombre de prestataires"
Union(c.Offset(0, 3), c.Offset(0, 4), c.Offset(0, 5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case Else
Union(c.Offset(0, 3), c.Offset(0, 4)).Select
Couleur = xlNone
End Select
With Range(c.AddressLocal & ":" & c.Offset(0,
5).AddressLocal).Interior
.ColorIndex = xlAutomatic
.Pattern = xlPatternNone
.PatternColorIndex = xlColorIndexNone
End With
With Selection.Interior
.ColorIndex = Couleur
.Pattern = Motif
.PatternColorIndex = CouleurMotif
End With

Next c
Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True


Dis nous ce que tu en pense
;-)

*Bonjour ALF*,
Pour tes boucles, tu gagnerais en temps si tu faisais ta boucle seulement sur
la colonne B :
For Each c In Range("B2:B73")
En complement, je ferais plutot un select case pour tout faire dans la même
boucle au lieu d'en faire 6. 6 boucles= 6 fois plus long :/

For Each c In Range("B2:Q73")

--
____
( O | O )
--
_oooO_ JLuc _Oooo_

O-O

Re ALF
j'ai testé un petit bout de code avec union, a adapter

Sub b()

Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet

For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Set tab1 = Range(c.Offset(0, 1), c.Offset(0, 2))
Set tab2 = Range(c.Offset(0, 4), c.Offset(0, 5))
Set maSélectionMultiple = Union(tab1, tab2)
maSélectionMultiple.Select

'Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
Exit Sub

A+
JP25

"ALF" <ALF@discussions.microsoft.com> a écrit dans le message de news:
EFEC8B54-A92D-4BF7-A899-DE73D9B9230A@microsoft.com...

Re,
et merci jp25 pour ta reponse..
le but de ce code est de selectionner certaines cellules qui sont à droite
de la cellule "Nom de l'indicateur",pour pouvoir les griser car ce sont
des
cellules qui n'auront jamais de valeurs..
c'est pourquoi,parfois il faut 3 ou 4 arguments à griser..
d'où le probleme car tu viens de me signaler qu'il ne peut y avoir que 2
arguments dans la fonction RANGE()...

y a t-il alors un autre moyen pour devier ce probleme ???

Merci encore pour votre soutien

--
ALF

Bonjour

le nb d'argument est maxi 2
Que souhaites tu en finalité
J'ai corrigé le nb d'arguments
Essaie ceci

Sub a()
Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) =
"Nombrede
d 'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant
MoyenCréance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c,
13)
_
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next

Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
End Sub

jp25

"ALF" <ALF@discussions.microsoft.com> a écrit dans le message de news:
749F86A7-7430-4277-9456-268414F1D9BB@microsoft.com...

Bonjour,

j'obtiend ce message d'erreur : erreur de compilation:
nombre d'arguments incorrect ou affectation de propriété incorrecte

et sur le code, l' erreur se positionne sur RANGE( au niveau de
"Départs
ACT" Et Apparemment,le 1er FOR EACH sur("Taux de siren") a bien passé..

Par contre sur le 2eme FOR EACH sur("Départs ACT") ne passe pas et
bloque
a
ce niveau la..

For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then

l'erreur se positionne ici-------->RANGE(c.Offset(0, 1), c.Offset(0,
2),
c.Offset(0, 4), c.Offset(0, 5)).Select
pouvez vous resoudre ce probleme..je vous laisse ci joint le code en
question.

Merci de votre soutien

Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4), c.Offset(0,
5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) =
"Nombre
de d'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant Moyen
Créance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c,
13)
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
Next s
Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
--


--
ALF

bonsoir jp25,

j'ai un probleme avec le code que tu m'a proposé car la macro bloque sur
MaSelectionMultiple.select..avec le message :OBJET requis manquant...
apparemment,Le code ne reconnait pas MaSelectionMultiple..
a quoi cela est il du, faut il rajouter un element de la bibilotheque
dans
outilreferences ???

merci pour ton soutien

--
ALF

Re ALF
j'ai testé un petit bout de code avec union, a adapter

Sub b()

Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet

For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Set tab1 = Range(c.Offset(0, 1), c.Offset(0, 2))
Set tab2 = Range(c.Offset(0, 4), c.Offset(0, 5))
Set maSélectionMultiple = Union(tab1, tab2)
maSélectionMultiple.Select

'Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
Exit Sub

A+
JP25

"ALF" <ALF@discussions.microsoft.com> a écrit dans le message de news:
EFEC8B54-A92D-4BF7-A899-DE73D9B9230A@microsoft.com...

Re,
et merci jp25 pour ta reponse..
le but de ce code est de selectionner certaines cellules qui sont à
droite
de la cellule "Nom de l'indicateur",pour pouvoir les griser car ce sont
des
cellules qui n'auront jamais de valeurs..
c'est pourquoi,parfois il faut 3 ou 4 arguments à griser..
d'où le probleme car tu viens de me signaler qu'il ne peut y avoir que
2
arguments dans la fonction RANGE()...

y a t-il alors un autre moyen pour devier ce probleme ???

Merci encore pour votre soutien

--
ALF

Bonjour

le nb d'argument est maxi 2
Que souhaites tu en finalité
J'ai corrigé le nb d'arguments
Essaie ceci

Sub a()
Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) >> >> "Nombrede
d 'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant
MoyenCréance" Or Left(c, 33) = "Nombre Total de dossiers en stock"
Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or
Left(c,
13)
_
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next

Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
End Sub

jp25

"ALF" <ALF@discussions.microsoft.com> a écrit dans le message de news:
749F86A7-7430-4277-9456-268414F1D9BB@microsoft.com...

Bonjour,

j'obtiend ce message d'erreur : erreur de compilation:
nombre d'arguments incorrect ou affectation de propriété incorrecte

et sur le code, l' erreur se positionne sur RANGE( au niveau de
"Départs
ACT" Et Apparemment,le 1er FOR EACH sur("Taux de siren") a bien
passé..

Par contre sur le 2eme FOR EACH sur("Départs ACT") ne passe pas et
bloque
a
ce niveau la..

For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then

l'erreur se positionne ici-------->RANGE(c.Offset(0, 1), c.Offset(0,
2),
c.Offset(0, 4), c.Offset(0, 5)).Select
pouvez vous resoudre ce probleme..je vous laisse ci joint le code en
question.

Merci de votre soutien

Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4), c.Offset(0,
5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) >> >> > "Nombre
de d'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant
Moyen
Créance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or
Left(c,
13)
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
Next s
Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
--


--
ALF

bonsoir jean luc,

et merci pour ton info..en effet cela semble interressant..
par contre,je comprends pas trop pourquoi utiliser seulement la colonne
B,etant donné que des cellules peuvent se trouver ailleurs que sur la colonne
B???
J'ai (lamentablement) supposé que ton tableau était structuré avec ces

d'autre part,j'ai un probleme pour Case Else Couleur=xlNone car certaines
cellules ont des motifs d'origine avec couleur...
J'ai mis un Case Else car dans ton code d'origine, si tu trouvais

existe t il dans ce cas Couleur = si Case est different de ceux declarés
alors laisser le motif d'origine...
Il suffit d'enlever le Case Else

et enfin,dans le code que m'avais propose jp25 ,la macro bloque sur
MaSelectionMultiple.select..avec le message :OBJET requis manquant...
Attention, si tu a copier une partie du code et réécrit une autre

merci pour ton soutien
Ce fut un plaisir

--
ALF

Voici le code obtenu :-) : plus simple à maintenir et on voit mieux ce
que l'on fait, moins long car moins de boucles

Dim FeuilleActive As Worksheet
Dim Couleur As Variant
Dim Motif As Long
Dim CouleurMotif As Long
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:B73")
Select Case c
Case "Taux de siren"
Union(c.Offset(0, 3), c.Offset(0, 4)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case Is = "Départs ACT"
Union(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4), c.Offset(0,
5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Nombre de dossiers par ETP", "Nombre de d 'avis par ETP"
Union(c.Offset(0, 1), c.Offset(0, 4), c.Offset(0, 5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Montant du Stock", "Montant Moyen Créance", "Nombre Total de
dossiers en stock"
Union(c.Offset(0, 4), c.Offset(0, 5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Efficacité du recouvrement (sans ACI)", "Nombre d' ACI",
"Montant d' ACI"
c.Offset(0, 5).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Nombre de prestataires"
Union(c.Offset(0, 3), c.Offset(0, 4), c.Offset(0, 5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case Else
Union(c.Offset(0, 3), c.Offset(0, 4)).Select
Couleur = xlNone
End Select
With Range(c.AddressLocal & ":" & c.Offset(0,
5).AddressLocal).Interior
.ColorIndex = xlAutomatic
.Pattern = xlPatternNone
.PatternColorIndex = xlColorIndexNone
End With
With Selection.Interior
.ColorIndex = Couleur
.Pattern = Motif
.PatternColorIndex = CouleurMotif
End With

Next c
Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True


Dis nous ce que tu en pense
;-)

*Bonjour ALF*,
Pour tes boucles, tu gagnerais en temps si tu faisais ta boucle seulement
sur la colonne B :
For Each c In Range("B2:B73")
En complement, je ferais plutot un select case pour tout faire dans la même
boucle au lieu d'en faire 6. 6 boucles= 6 fois plus long :/

For Each c In Range("B2:Q73")

--
____
( O | O )
--
_oooO_ JLuc _Oooo_

O-O