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
| Private Sub CommandButton4_Click()
'Réf Camad.xls
Dim c As Range, Ctr As Integer, Col As Integer, Plage As Range
Worksheets("Synthese").Select
'la variable Col renseigne la colonne en écriture
Col = 4
With Sheets("sheet")
'colonnes utilisées pour trier les données sélectionnées
.[J:K].ClearContents
Ctr = 0
'boucle sur la colonne A de la feuille sheet
For Each c In .Range(.[A3], .cells(.Rows.Count, 1).End(xlUp))
'si la valeur est égale à l'une des 4 noms de la feuille Synthese
If c.Value = cells(43, 3) Or c.Value = cells(44, 3) Or c.Value = cells(45, 3) _
Or c.Value = cells(46, 3) Then
Ctr = Ctr + 1
'on écrit les valeurs en colonne J et K
.cells(Ctr, 10) = c.Value
.cells(Ctr, 11) = c.Offset(, 1).Value
End If
Next c
'on trie la colonne K (date)
.[J:K].Sort .[K1], xlAscending, Header:=xlNo
Set Plage = .Range(.[K1], .cells(.Rows.Count, 11).End(xlUp))
Col = 4
'on parcourt la colonne K
For Each c In Plage
's'il y a plus de deux fois la même date
'et que la date n'a pas été déjà recopiée
If Application.CountIf(Plage, c.Value) > 2 And _
Application.CountIf([D41:N41], c.Value) = 0 Then
'on écrit la date en ligne 1
cells(41, Col) = c.Value
Col = Col + 1
End If
Next c
.[J:K].ClearContents
End With
End Sub |
Partager