Sub transfert()
Set w = ActiveWorkbook
tablo = Range("A2:Q" & Range("A" & Rows.Count).End(xlUp).Row)
For n = LBound(tablo, 1) To UBound(tablo, 1)
If tablo(n, 15) = "A" And tablo(n, 17) = "" Then
x = Workbooks("archives.xlsm").Sheets.Count
y = CStr(tablo(n, 1))
w.Sheets(y).Move After:=Workbooks("archives.xlsm").Sheets(x)
End If
Next
End Sub