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 28 29 30 31 32 33 34 35 36 37 38 39 40 41
| Sub RemplissagePCK()
Dim Plage As Range, C As Range, S2 As Variant, S1 As Variant
Dim Ligne As Integer, Lig As Integer, Cols As Variant, Col As Integer
Cols = Array(2, 3, 4, 5, 6, 7, 11, 12, 13, 14, 15, 16, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31)
With Sheets("Suivi hebdo")
S2 = Application.Max(.[A:A])
S1 = InputBox("Entrez un n° de semaine entre 2 et " & S2)
If S1 = "" Or CInt(S1) > S2 Or CInt(S1) < 2 Then Exit Sub
S1 = CInt(S1)
Ligne = Application.Match(S1, .[A:A], 0)
Set Plage = .Cells(Ligne, 2).Resize(, 52)
End With
Lig = 8
Col = 1
With Sheets("Structure Instances PCK")
'boucle de suppression des flèches
For Each Sh In .Shapes
If Sh.TopLeftCell.Column = 7 Then Sh.Delete
Next Sh
For Each C In Plage
Col = Col + 1
If IsNumeric(Application.Match(C.Column, Cols, 0)) Then
If C.Offset(-Ligne + 3).Value = "Entrées" Then
Lig = Lig + 1
.Cells(Lig, 3) = C.Value
ElseIf C.Offset(-Ligne + 3).Value = "Traités" Then
.Cells(Lig, 5) = C.Value
ElseIf C.Offset(-Ligne + 3).Value = "Solde" Then
.Cells(Lig, 6) = C.Value
If C.Value = C.Offset(-1).Value Then
.[K10].Copy .Cells(Lig, 7)
ElseIf C.Value > C.Offset(-1).Value Then
.[K9].Copy .Cells(Lig, 7)
ElseIf C.Value < C.Offset(-1).Value Then
.[K11].Copy: .Cells(Lig, 7).Paste
End If
End If
End If
Next C
End With
End Sub |
Partager