Sub TestAdo()
Dim Sh As Worksheet
Dim Select_String As String
Dim Sql_Driver As String
Const Liste_Onglets = ";CP;CE1;CE2;CM1;CM2;"
Sql_Driver = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
"DBQ=" & ThisWorkbook.FullName & ";READONLY=FALSE"
Application.ScreenUpdating = False
For Each Sh In ThisWorkbook.Worksheets
If InStr(1, Liste_Onglets, ";" & Sh.Name & ";", vbTextCompare) Then
If Select_String <> "" Then Select_String = Select_String & " union "
Select_String = Select_String & _
" Select Classe, Nom, Prenom, Matiere, Devoir " & _
" From [" & Sh.Name & "$] Where Note=0 "
End If
Next
If Select_String <> "" Then
On Error Resume Next
Me.Activate
Me.Rows("2:" & Me.Cells(Me.Rows.Count, "A").End(xlUp).Row + 1).Clear
Set Source_Folder = CreateObject("ADODB.Connection")
Source_Folder.Open Sql_Driver
Set Source_Filtre = CreateObject("ADODB.Recordset")
Source_Filtre.ActiveConnection = Source_Folder
Source_Filtre.Open Select_String
Select Case True
Case Err <> 0: MsgBox "Erreur " & Err().Number & vbLf & Err().Description
Case Source_Filtre.EOF
Case Else: Me.[A2].CopyFromRecordset Source_Filtre
End Select
Source_Filtre.Close
Set Source_Filtre = Nothing
Set Source_Folder = Nothing
End If
End Sub