Sub TEST()
    'Call ExtraireCopierCellules("Nom du chemin complet (Fichier compris)", "Onglet du fichier fermé", "Plage a récupérer", False, "Cellule a/c de laquelle seront copiées les données")
    Call ExtraireCopierCellules("C:\MesDocuments\Paninak.xlsx", "Feuil1", "A1:F100", False, "H7")
End Sub
Sub ExtraireCopierCellules(ByVal xNomPathFile As String, ByVal xOnglet As String, ByVal xPlage As String, xEntete As Boolean, xCellule As String)
    
    '----------------------------------------------------------------------
    '                                                      POUR INFORMATION
    '
    '  Nécessite la référence Microsoft ActiveX Data Objects x.x Library
    '
    '  xNomPathFile = Nom du chemin et du fichier complet
    '  xOnglet      = Nom de l'onglet du classeur fermé
    '  xPlage       = Plage de cellule à lire (Doit dépasser la valeur de la dernière ligne et colonne pour pouvoir récupérer l'intégralité Ligne et Colonne)
    '  xEntete      = Indiquer True / False si on veut ou pas récupérer les entêtes de données
    '  xCellule     = Cellule (du fichier ouvert) à partir de laquelle les données seront copiées
    '----------------------------------------------------------------------
    
    Dim Cn As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim ADOCommand As ADODB.Command
    
    If OkSheetName(xNomPathFile, xOnglet) Then      'Vérifier que l'onglet existe dans le fichier source
        '----------------------------------------------------------------
        '                                 Ouvrerture VIRTUELLE du Fichier
        '----------------------------------------------------------------
        Set Cn = New ADODB.Connection               'Connexion
        With Cn
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & xNomPathFile & ";Extended Properties=""Excel 12.0;HDR=YES;"""
            .Open
        End With
       
        '----------------------------------------------------------------
        '                                                         Requête
        '----------------------------------------------------------------
        Set ADOCommand = New ADODB.Command                          'Requête pour lire la xPlage recherchée
        With ADOCommand
            .ActiveConnection = Cn
            .CommandText = "SELECT * FROM [" & xOnglet & "$" & xPlage & "]"
        End With
        Set Rst = New ADODB.Recordset
        Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
        xLig = Rst.RecordCount + 1                                  'Permet de connaitre la dernière ligne du fichier fermé
        xCol = Rst.Fields.Count                                     'Permet de connaitre la dernière colonne du fichier fermé
        xLettreColonne = Split(Cells(1, xCol).Address, "$")(1)      'Transforme la valeur de la colonne en lettre Excel
        xPlage = Left(xPlage, 3) & xLettreColonne & xLig            'Redefini la Plage d'origine en nouvelle Plage
        Set Rst = Cn.Execute("[" & xOnglet & "$" & xPlage & "]")
        
        '----------------------------------------------------------------
        '  Détermine la ligne et la colonne ou seront copiées les données
        '----------------------------------------------------------------
        For F = 1 To Len(xCellule)
            If IsNumeric(Mid(xCellule, F, 1)) = True Then
                xPos = F
                Exit For
            End If
        Next F
        xLig2 = Val(Mid(xCellule, xPos, 10))
        xCol2 = Range(Left(xCellule, xPos - 1) & 1).Column          'Transforme la lettre de la colonne en valeur chiffrée
        
        '----------------------------------------------------------------
        '                        Copie les données lues a/c de la cellule
        '----------------------------------------------------------------
        
        '---------------------------------------------------- RECUPERATION DES ENTESTES
        If xEntete = True Then
            For F = 1 To xCol
                'Précision : Si l'entête est vierge, la macro inscrira F? (Field n°) à la place
                Cells(xLig2, xCol2 - 1 + F) = Rst.Fields(F - 1).Name
            Next F
            xLig2 = xLig2 + 1
        End If
        '---------------------------------------------------- RECUPERATION DU RESTE DES DONNEES
        Do While Not Rst.EOF                                'Boucle sur les données
            If Rst.Fields(0).Value <> "" Then
                For F = 1 To xCol
                    Cells(xLig2, xCol2 - 1 + F) = Rst.Fields(F - 1).Value   'Passe en revue toutes les colonnes
                Next F
                xLig2 = xLig2 + 1
            End If
            Rst.MoveNext                                    'Prochaine ligne
        Loop
        '----------------------------------------------------------------
        '                                      Fermeture de la connection
        '----------------------------------------------------------------
        Rst.Close
        Cn.Close
        Set Cn = Nothing
        Set Rst = Nothing
        Set ADOCommand = Nothing
    End If
End Sub
Private Function OkSheetName(FullPathFile As String, SheetName As String) As Boolean
    '----------------------------------------------------------------------
    '                                                      POUR INFORMATION
    '
    '  Nécessite la référence Microsoft ADO Ext. 6.0 for DDL and Security
    '----------------------------------------------------------------------
    
    Dim Cn As ADODB.Connection
    Dim oCat As ADOX.Catalog
    Dim Tbl As Object
    Set Cn = New ADODB.Connection
    xOnglet = SheetName & "$"
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FullPathFile$ & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
    Set oCat = New ADOX.Catalog
    Set oCat.ActiveConnection = Cn
    For Each Tbl In oCat.Tables
        If Tbl.Name Like xOnglet Then
            OkSheetName = True
            GoTo Suite
        End If
    Next Tbl
    MsgBox "L'onglet   " & SheetName & "   ne se trouve pas dans le fichier   " & FullPathFile, vbCritical, "PAS D'ONGLET DANS LE FICHIER SPECIFIE"
Suite:
    Set oCat = Nothing: Cn.Close: Set Cn = Nothing
End Function