Faire tourner une macro sur toutes feuilles !

Fermé
Polo_windsurf - Modifié par Polo_windsurf le 19/07/2011 à 14:17
melanie1324 Messages postés 1505 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 - 19 juil. 2011 à 15:13
Bonjour,

Je suis débutant en vba. J'ai fait la macro suivante afin de, quand une cellule est en couleur verte, de prendre la somme de ou des cellules en vert.
Jelui demande de faire tourner la macro sur toutes les feuilles ... c'est ce que la macro fait ... mais à la fin ça bugue!! quelqu'un aurait-il une solution (peut-être vavec sheets.count??)

Merci bcp par avance!!

Paul

Sub Macro1()
'

Dim i As Integer
For i = 7 To 91
If Range("D" & i).Interior.ColorIndex = 4 And Range("E" & i).Interior.ColorIndex = 4 And Range("F" & i).Interior.ColorIndex = 4 Then
Range("q" & i).Value = "xxx"
ElseIf Range("D" & i).Interior.ColorIndex = 4 And Range("E" & i).Interior.ColorIndex = 4 Then
Range("q" & i).Value = "xx"
ElseIf Range("D" & i).Interior.ColorIndex = 4 Then
Range("q" & i).Value = "x"

ElseIf Range("D" & i).Interior.ColorIndex <> 4 Then
Range("r" & i).Value = ""


End If
Next i

'permets d'écrire la formule à gauche de "xx"'

Range("Q1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Activate
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(IF(RC[-1]=""x"",RC[-14],IF(RC[-1]=""xx"",RC[-14]+RC[-13],IF(RC[-1]=""xxx"",RC[-14]+RC[-13]+RC[-12],"""")))),"""",IF(RC[-1]=""x"",RC[-14],IF(RC[-1]=""xx"",RC[-14]+RC[-13],IF(RC[-1]=""xxx"",RC[-14]+RC[-13]+RC[-12],""""))))"
ActiveCell.Activate
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=12
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

ActiveSheet.Next.Activate
'permets de réexécuter la macro sur les aures plages

Call Macro1


End Sub
A voir également:

1 réponse

melanie1324 Messages postés 1505 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 154
19 juil. 2011 à 15:13
bonjour,

Sub Macro1()
'

Dim i As Integer
Dim Ws As Worksheet


For Each Ws In Worksheets

For i = 7 To 91
If ws.Range("D" & i).Interior.ColorIndex = 4 And ws.Range("E" & i).Interior.ColorIndex = 4 And ws.Range("F" & i).Interior.ColorIndex = 4 Then
ws.Range("q" & i).Value = "xxx"
Else
If ws.Range("D" & i).Interior.ColorIndex = 4 And ws.Range("E" & i).Interior.ColorIndex = 4 Then
ws.Range("q" & i).Value = "xx"
Else
If ws.Range("D" & i).Interior.ColorIndex = 4 Then
ws.Range("q" & i).Value = "x"

Else
If ws.Range("D" & i).Interior.ColorIndex <> 4 Then
ws.Range("r" & i).Value = ""


End If
Next i

'permets d'écrire la formule à gauche de "xx"'

Ws.select
Range("Q1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Activate
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(IF(RC[-1]=""x"",RC[-14],IF(RC[-1]=""xx"",RC[-14]+RC[-13],IF(RC[-1]=""xxx"",RC[-14]+RC[-13]+RC[-12],"""")))),"""",IF(RC[-1]=""x"",RC[-14],IF(RC[-1]=""xx"",RC[-14]+RC[-13],IF(RC[-1]=""xxx"",RC[-14]+RC[-13]+RC[-12],""""))))"
ActiveCell.Activate
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=12
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False





Next Ws
End Sub
0