Fichier Bilan sous Excel

Option Explicit
'necessite d'activer la reference Microsoft ActiveX Data Objects 2.x Library
'dans Outils, référence où x est un numéro de version
Dim cnx As ADODB.Connection
Function GetConnectionOk(ByVal fichier As String) As Boolean
    If Not cnx Is Nothing Then
        'Si la connexion est ouvert
        If cnx.State = adStateOpen Then cnx.Close
    End If
    Set cnx = Nothing
    If Dir(fichier) = "" Then
        MsgBox "Le fichier (" & fichier & ") n'existe pas", vbExclamation, "Connexion au fichier"
        Set cnx = New ADODB.Connection
        With cnx
            .ConnectionString = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
                                "data source=" & fichier & ";" & _
                                "extended properties=""Excel 8.0;"""
            .CursorLocation = adUseClient
            .Open
            GetConnectionOk = .State = adStateOpen
        End With
    End If
End Function
Private Function GetListeFichier()
    Dim chemin As String, fichier As String
    Dim annee As Integer
    Dim idx As Byte
    Dim t(1 To 12) As String
    'Remplacer Feuil1 par le nom de la feuille idoine
    chemin = Sheets("[SIZE=3][COLOR=olive]Feuil1[/COLOR][/SIZE]").Range("C1")
    annee = Sheets("[SIZE=3][COLOR=olive]Feuil1[/COLOR][/SIZE]").Range("C2")
    If Dir(chemin) = "" Then
        MsgBox "Le répertoire (" & chemin & ") n'existe pas", vbExclamation, "Liste fichiers"
        Exit Sub
    End If
    If annee = 0 Then
        MsgBox "Mettez une année en C1", vbExclamation, "Liste fichiers"
        Exit Sub
    End If
 
    If Not Right(chemin, 1) = "\" Then chemin = chemin & "\"
 
    For i = 1 To 12
        fichier = chemin & CStr(annee) & "_" & Format(idx, "00") & ".xls"
        If Dir(fichier) <> "" Then
            t(i) = fichier
        Else
            t(i) = ""
        End If
    Next i
    GetListeFichier = t
End Function
 
Private Sub CommandButton1_Click()
    Dim rs As ADODB.Recordset
    Dim i As Byte
    Dim ligne As Long
    Dim listeFichiers
    Dim sql As String
    sql = "SELECT * FROM [Feuil1$D10:M18];"
    listeFichiers = GetListeFichier()
    ligne = 10
    For i = 1 To 12
        If i < 11 Then
            'Remplacer Feuil1 par le nom de la feuille source
            sql = "SELECT * FROM [[SIZE=3][COLOR=red]Feuil1[/COLOR][/SIZE]$D10:M18];"
        Else
            sql = "SELECT * FROM [[SIZE=3][COLOR=red]Feuil1[/COLOR][/SIZE]$D15:M24];"
        End If
        If listeFichiers(i) <> "" Then
            If GetConnectionOk(listeFichiers(i)) Then
                Set rs = New Recordset
                rs.Open sql, cnx, adOpenKeyset, adLockOptimistic
                If rs.State = adStateOpen Then
                    'Remplacer "Destination" par le nom de la feuille de réception des données
                    With Sheets("[SIZE=3][COLOR=blue]Destination[/COLOR][/SIZE]")
                        .Cells(ligne, 1).CopyFromRecordset rs
                        ligne = ligne + rs.RecordCount + 2
                    End With
                    rs.Close                          'Fermeture du recordset
                End If
                Set rs = Nothing                      'Destruction du recordset
                cnx.Close                             'Fermeture de la connexion
                Set cnx = Nothing                     'Destruction de la connexion
            End If                                    'connection
        End If                                        'Fichier
    Next i
End Sub