WDAndCo
XLDnaute Impliqué
Bonjour le Forum
Je reviens vers vous car je bute de nouveau ! Car je voudrais déplacer l'onglet si :
If DE + MP + HD = 0 Then L'onglet prendre la place de l'onglet a sa droite.
Cela doit se fait dans la Macro qui suit. Afin d'avoir tous les onglets DE + MP + HD = 0 donc vert à droite avec a l’extrême droite le plus vieux. Tous cela est inclus dans cette Macro qui ce déclenche pour mettre à jour un onglet qui reprends certaines informations pressente sur d'autres onglets
D'avance merci.
Dominique
Je reviens vers vous car je bute de nouveau ! Car je voudrais déplacer l'onglet si :
If DE + MP + HD = 0 Then L'onglet prendre la place de l'onglet a sa droite.
Cela doit se fait dans la Macro qui suit. Afin d'avoir tous les onglets DE + MP + HD = 0 donc vert à droite avec a l’extrême droite le plus vieux. Tous cela est inclus dans cette Macro qui ce déclenche pour mettre à jour un onglet qui reprends certaines informations pressente sur d'autres onglets
D'avance merci.
Dominique
Code:
Private Sub Worksheet_Activate()
Range("A2:J2").Select
Selection.AutoFilter
With Worksheets("Points à Amortir")
If .AutoFilter Is Nothing Then .Range("A2:J2").AutoFilter
.Columns("A:H").Select
ActiveWindow.Zoom = True
.Range("I1").Select
End With
If Sheets(5).Name = Range("K1").Value Then Exit Sub
[A2:I1000].ClearContents
Range("A2").Value = "N° du CR"
Range("B2").Value = "Dates"
Range("C2").Value = "Lieux"
Range("D2").Value = "N° Points"
Range("E2").Value = "Installations"
Range("F2").Value = "Points à Amortir"
Range("G2").Value = "Delais"
Range("H2").Value = "Moyen nécessaires ou Intéressés"
DL = 3 'DL = Derniere Ligne
'For I = 5 To Sheets.Count 'Tous les onglets a partir du 5eme
For I = Sheets.Count To 5 Step -1 'Tous les onglets de la fin au 5eme
nf = Sheets(I).Name
Sheets(I).Tab.ColorIndex = 4 'Vert
With Sheets(I)
DE = 0
MP = 0
HD = 0
NL = .Range("L1").Value 'Nb de ligne sur l'onglet
For L = 12 To NL + 11
If .Range("G" & L).Value <> "" And .Range("G" & L).Value <> Descision And .Range("H" & L).Value = "" And InStr(.Range("E" & L).Value, "Voie") = 0 Then
ActiveSheet.Hyperlinks.Add Anchor:=Cells(DL, 1), Address:="", SubAddress:="'" & _
nf & "'" & "!H12", TextToDisplay:=nf
ActiveSheet.Range("B" & DL).Value = .Range("C8").Value
ActiveSheet.Range("D" & DL).Value = .Range("A" & L).Value
ActiveSheet.Range("E" & DL).Value = .Range("C" & L).Value
ActiveSheet.Range("F" & DL).Value = .Range("D" & L).Value
ActiveSheet.Range("G" & DL).Value = .Range("G" & L).Value
ActiveSheet.Range("H" & DL).Value = .Range("E" & L).Value
If .Range("G" & L).Value = "D" Then DE = DE + 1 Else MP = MP + 1
If MP > DE Then Couleur = 41 Else Couleur = 44 'Orange
If .Range("B" & L).Value = "" Then ActiveSheet.Range("C" & DL).Value = .Range("B12").Value Else ActiveSheet.Range("C" & DL).Value = .Range("B" & L).Value
Sheets(I).Tab.ColorIndex = Couleur
If ActiveSheet.Range("J" & DL).Value < 0 Then HD = HD + 1
DL = DL + 1
End If
Next L
If HD > 0 Then Sheets(I).Tab.ColorIndex = 3 'Rouge
End With
'If DE + MP + HD = 0 Then L'onglet prendre la place de l'onglet a sa droite
Next I
Range("A2:H2").Select
Selection.AutoFilter
Columns("A:H").Select
ActiveWindow.Zoom = True
'Range("I1").Value = DL
Range("A1").Value = "RECAPITULATIF des " & DL - 3 & " points restant à Amortir des Visites EF 5A n°7"
Range("K1").Value = Sheets(5).Name
Range("I1").Select
End Sub
