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 42 43 44 45 46 47 48 49 50 51 52 53 54
| Option Compare Text
Sub Valider_Cliquer() 'Première partie pour recopier dans retenue
Application.ScreenUpdating = False
Dim NbYes As Integer
Dim Debut, Fin As Long
Sheets("ENT_BET").Activate
NbYes = Application.WorksheetFunction.CountIf(Columns("F"), "Oui")
Select Case NbYes
Case Is > 0
'On nettoie la feuille AMT
Sheets("AMT").Activate
Range("A3", "C1000").Clear
Range("D3:M1000").Borders.LineStyle = xlLineStyleNone
Sheets("ENT_BET").Activate
'On demande un tri sur la colonne F
Range("A2", Cells(Range("A2").End(xlDown).Row, "G").Address).Sort _
key1:=Range("F2"), order1:=xlDescending, dataoption1:=xlSortNormal, Header:=xlYes
Debut = Columns("F").Find("Oui", , xlValues, xlWhole).Row
Fin = Debut + NbYes - 1
Union(Range(Cells(Debut, 1).Address, Cells(Fin, 3).Address), Range(Cells(Debut, 7).Address, Cells(Fin, 7).Address)).Copy
Sheets("AMT").Activate
Range("A3").PasteSpecial xlPasteValues
End Select
For i = 3 To 100 'Pour bordure
If Not IsEmpty(Cells(i, 1)) Then
For j = 1 To 13 'Colonne
Cells(i, j).Borders(xlEdgeLeft).LineStyle = xlContinuous
Cells(i, j).Borders(xlEdgeRight).LineStyle = xlContinuous
Cells(i, j).Borders(xlEdgeTop).LineStyle = xlContinuous
Cells(i, j).Borders(xlEdgeBottom).LineStyle = xlContinuous
Next
End If
Next
With Range("A3:M150")
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
End With
Range("F3:M150").Select
Selection.NumberFormat = "m/d/yyyy"
For i = 3 To Range("A65536").End(xlUp).Row
Cells(i, 1).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Next
Sheets("Retenue").Activate
End Sub |
Partager