Private Sub CommandButton3_Click()
'Bouton Test
Dim DL1, DL2, LIG1 As Long, Ligne As Long
Dim NumEcrou As Object
Extr = Array("", "Primaire hors SSJ", "Primaire ac SSJ ", "Récidivistes hors SSJ", "Récidivistes ac SSJ", "") '<--- Ligne ajoutée
Application.ScreenUpdating = False
'Verification n° Ecrou
For Each sh In ThisWorkbook.Sheets
If InStr(sh.Name, "Extractions") > 0 Then
With sh
DL1 = .Range("A65536").End(xlUp).Row
For LIG1 = 2 To DL1
VPremier = .Cells(LIG1, 1)
Set NumEcrou = Sheets("Tableau PSAP").Range("A:A").Find(VPremier, LookIn:=xlValues, lookat:=xlWhole)
If Not NumEcrou Is Nothing Then
Ligne = NumEcrou.Row
Else
Ligne = Sheets("Tableau PSAP").Range("A65536").End(xlUp).Row + 1
End If
Sheets("Tableau PSAP").Range("A" & Ligne) = .Range("A" & LIG1)
Sheets("Tableau PSAP").Range("I" & Ligne) = .Range("B" & LIG1)
Sheets("Tableau PSAP").Range("K" & Ligne) = Extr(Right(sh.Name, 1)) '<--- Ligne ajoutée
Next
End With
End If
Next
Application.ScreenUpdating = True
End Sub