Option Explicit
Sub TabGraph()
Sheets("TabGraph").Select
Call copie(Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row + 1), "A chiffrer", 3, 5)
Call copie(Range("H2:M" & Cells(Rows.Count, 8).End(xlUp).Row + 1), "Validé", 10, 12)
Call copie(Range("O2:T" & Cells(Rows.Count, 15).End(xlUp).Row + 1), "Attente MOA", 17, 19)
Call copie(Range("U2:AA" & Cells(Rows.Count, 22).End(xlUp).Row + 1), "Attente MOE", 24, 26)
End Sub
Sub copie(P As Range, Tx As String, Deb As Byte, Fin As Byte)
Dim Lig As Long, sh As Worksheet
Lig = 2
P.ClearContents 'plage à effacer
Application.ScreenUpdating = False
For Each sh In Worksheets
If Left(sh.Name, 2) = "Bi" Then
Dim Dl As Long, Li As Long, Co As Byte
Cells(Lig, Deb - 1) = CDate(Replace(Right(sh.Name, 10), "-", "/"))
Cells(Lig, Deb - 2) = Tx 'Texte à écrire, tester
Dl = sh.Cells(Rows.Count, 2).End(xlUp).Row
For Li = 3 To Dl
If sh.Cells(Li, 2) = Tx Then
If sh.Cells(7, 5) = "Hors garantie" Then
Cells(Lig, Deb) = Cells(Lig, Deb) + sh.Cells(Li, 3)
Cells(Lig, Deb + 1) = Cells(Lig, Deb + 1) + sh.Cells(Li, 4)
Cells(Lig, Deb + 2) = Cells(Lig, Deb + 2) + sh.Cells(Li, 5)
Cells(Lig, Deb + 3) = Cells(Lig, Deb + 3) + sh.Cells(Li, 6)
Else
Cells(Lig, Deb) = Cells(Lig, Deb) + sh.Cells(Li, 3)
Cells(Lig, Deb + 1) = Cells(Lig, Deb + 1) + sh.Cells(Li, 4)
Cells(Lig, Deb + 3) = Cells(Lig, Deb + 3) + sh.Cells(Li, 5)
End If
Range(Cells(Lig, Deb - 2), Cells(Lig, Deb + 3)).Borders.Value = 1
End If
Next
Lig = Lig + 1
End If
Next
End Sub