Sub ExporterEchecs(w As Worksheet)
Dim chemin$, P As Range, note, n&, c As Range, nom$
chemin = ThisWorkbook.Path & "\Echecs\" 'à adapter éventuellement
Set P = w.UsedRange
If InStr(P(2, 2), "/") = 0 Then Exit Sub
note = Split(P(2, 2), "/")(1) / 2 'note limite
If Application.CountIf(P.Columns(2), "<" & note) = 0 Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
MkDir chemin 'crée le dossier Echecs s'il n'existe pas
With Workbooks.Add(xlWBATWorksheet).Sheets(1) 'nouveau document
.Name = P.Parent.Name
P(1).Resize(2, 2).Copy .[A1]
n = 2
For Each c In P.Columns(2).Cells
If c < note And c <> "" Then
n = n + 1
.Cells(n, 2) = c
.Cells(n, 1) = c(1, 0)
End If
Next
.Columns(1).AutoFit 'ajustement automatique
nom = Left(Split(ThisWorkbook.Name)(1), 7) 'année-mois
nom = .[B1] & " " & .[A1] & " " & nom & _
IIf(Val(Application.Version) < 12, ".xls", ".xlsx")
Workbooks(nom).Close ' au cas où ce fichier serait ouvert
ActiveWorkbook.SaveCopyAs chemin & nom
ActiveWorkbook.Close
End With
End Sub