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
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
A voir également:
- Faire tourner une macro sur toutes feuilles !
- Macro word - Guide
- Macro logiciel - Télécharger - Organisation
- Tourner l'écran - Guide
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Macro recorder - Télécharger - Confidentialité
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
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
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