Option Explicit
Private Sub Worksheet_Activate()
[A3:J31000].ClearContents
Dim derlig
Dim DL, Te(), Le As Long, Ts(1 To 10000, 1 To 7), Ls As Long, I As Long, NF As String, _
F As Worksheet, PlgLgn As Range, A As Range
For I = 1 To Worksheets.Count
Set F = Worksheets(I): NF = F.Name
If Left$(NF, 1) = "S" Then
F.Unprotect
'Set PlgLgn = F.Columns("AG").SpecialCells(xlCellTypeConstants).EntireRow
Set PlgLgn = F.Columns("AG").SpecialCells(xlCellTypeFormulas).EntireRow
Set PlgLgn = Intersect(F.Columns("AC").SpecialCells(xlCellTypeFormulas).EntireRow, PlgLgn)
For Each A In PlgLgn.Areas
Te = A.Resize(, 33).Value
For Le = 1 To UBound(Te, 1)
Ls = Ls + 1
Ts(Ls, 1) = NF
Ts(Ls, 2) = Te(Le, 14)
Ts(Ls, 3) = Te(Le, 15)
Ts(Ls, 4 - (Te(Le, 33) = "R")) = Te(Le, 29)
Ts(Ls, 6) = Te(Le, 32)
Ts(Ls, 7) = Te(Le, 33)
Next Le, A: End If: Next I
Me.[A3:G1000].Value = Ts
'Application.Calculation = xlAutomatic
derlig = Range("A" & Rows.Count).End(xlUp).Row
Range("A1").Value = derlig
For DL = derlig To 3 Step -1 'Supprime les lignes inutilles
If Range("D" & DL).Value = 0 And Range("E" & DL).Value = 0 Then Rows(DL).Delete
Next DL
End Sub