1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
| Sub Calcul()
Dim i As Integer
Dim TbSce, TbDes
TbSce = Array("O5", "P5", "O6", "Q6", "M7", "M8", "M9", "O10", "P10", "M11", "M12", "R12", "M13") '...etc
TbDes = Array("B3", "B4", "B5", "B6", "B7", "B8", "B9", "B10", "B11", "B12", "B13", "B14", "B14") '..etc
ThisWorkbook.Sheets("INVENTAIRE").Range("B3:B23").ClearContents
For i = 0 To UBound(TbSce)
Call SousCalcul(TbSce(i), TbDes(i))
Next i
End Sub
Private Sub SousCalcul(ByVal CelSce As String, ByVal CelDes As String)
Dim Ws As Worksheet
Dim Q As Double
With ThisWorkbook
For Each Ws In .Worksheets
If Ws.Name <> "INVENTAIRE" Then
If Ws.Range(CelSce).Interior.ColorIndex = 43 Then Q = Q + 1
End If
Next Ws
With .Worksheets("INVENTAIRE").Range(CelDes)
.Value = .Value + Q
End With
End With
End Sub |
Partager