Macro pour aller chercher des données d'un autre excel vers le fichier de la macro.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
''Early Bindind
'Mettre en référence "Microsoft ActiveX Data Objects x.x Library" et " Microsoft ADO ext x.x for DLL and Security"
'(Outil, Références)
'     Dim Cn As ADODB.Connection
'     Dim oCat As ADOX.Catalog, Feuille As ADOX.Table
'     Set Cn = New ADODB.Connection
'     Set oCat = New ADOX.Catalog
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'Late Binding
     Dim Cn As Object
     Dim oCat As Object, Feuille As Object
     Set Cn = CreateObject("ADODB.Connection")
     Set oCat = CreateObject("ADOX.Catalog")
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
     Dim NomFeuilles$, MonFich
    
     If Target.Address <> [NomFich].Address Then Exit Sub
     ChDir ThisWorkbook.Path
     MonFich = Application.GetOpenFilename("Fichiers Excel (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm", , "Fichier Excel SOURCE")
     If MonFich = False Then
          'Effacer le nom de fichier et la liste des feuilles (validation de données de la cellule "NomFeuille")
          [NomFich].ClearContents
          [NomFeuille].ClearContents
          [NomFich].Offset(0, -1).Select
          With Sh_Accueil.[NomFeuille].Validation
               .Delete
               .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=","
          End With
          Exit Sub
     End If
    
'Ecrire le nom du fichier
     [NomFich].Value = MonFich
     [NomFeuille].Select
'Collecter le nom des feuilles
     '--- Connexion ---
     With Cn
         .Provider = "Microsoft.Jet.OLEDB.4.0"
         .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
             & MonFich & ";Extended Properties=""Excel 12.0;HDR=YES;ReadOnly=True;"""
         .Open
     End With
     Set oCat.ActiveConnection = Cn
    
'Liste des feuilles
     For Each Feuille In oCat.Tables
          TxtFeuil = Replace(Feuille.Name, Chr(39), "")
          If Right(TxtFeuil, 1) = "$" Then NomFeuilles = NomFeuilles & Replace(TxtFeuil, "$", "") & ","
     Next
    
'Validation de la cellule "NomFeuille" = liste des feuilles trouvées
     With [NomFeuille].Validation
          .Delete
          .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=NomFeuilles
     End With
     [NomFeuille].ClearContents
    
'Nb de lignes et de colonnes en fonction du type de fichier
     If Right(MonFich, 4) = ".xls" Then
          LgnMax = 65536
          ColMax = 256
     Else
          LgnMax = 1048576
          ColMax = 16384
     Set Feuille = Nothing
     End If

'Validation des cellules NbLignes et NbColonnes
     With [NbLignes].Validation
          .Delete
          .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="1", Formula2:=LgnMax
     End With
     With [NBColonnes].Validation
          .Delete
          .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="1", Formula2:=ColMax
     End With
    
     Set Feuille = Nothing
     Set oCat = Nothing
     Cn.Close
     Set Cn = Nothing
    
End Sub

Sub ImporterPlageFichierFermé()

'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
''Early Binding
''Mettre "Microsoft Scripting Runtime" en référence (Outil, Références)
'     Dim FSO As New Scripting.FileSystemObject
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'Late Binding
''Pas de bibliothèque en référence
     Dim FSO As Object
     Set FSO = CreateObject("Scripting.FileSystemObject")
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
     Dim Btn$, Fichier$, Feuille$, Cellule$, Chemin$, Classeur, NbLgn As Long, NbCol As Long, Réf$
     Dim Bouton As Shape
    
'Appel via le bouton obligatoirement
     Btn = ""
     On Error Resume Next
     Btn = Application.Caller
     On Error GoTo 0
     If Btn = "" Then Exit Sub
    
'Message du bouton commence par "Importer la plage $" obligatoirement
     Set Bouton = Sh_Accueil.Shapes("Shp_Importer")
     If Not Bouton.DrawingObject.Caption Like "Importer la plage $*" Then Exit Sub
    
'Lecture des données d'entrée
     Application.ScreenUpdating = False
     With Sh_Accueil
          Fichier = .[NomFich].Cells(1).Value
          Feuille = .[NomFeuille].Value
          Cellule = .[Cell1].Value
          NbLgn = WorksheetFunction.Max(.[NbLignes].Value, 1)
          NbCol = WorksheetFunction.Max(.[NBColonnes].Value, 1)
     End With
    
'Extraction du chemin du fichier à importer et du nom du fichier
     Chemin = FSO.GetParentFolderName(Fichier)
     Classeur = FSO.GetFileName(Fichier)
    
'Référence de la première cellule à importer (référence externe avec nom complet du fichier)
     Réf = "'" & Chemin & "\[" & Classeur & "]" & Feuille & "'!" & Cellule
     'Formule avec gestion des cellules vide (pour ne pas récupérer des zéros à la place des vides)
     Formule = "=IF(ISBLANK(" & Réf & "),""""," & Réf & ")"
     'Nettoyage de la feuille cible
     Sh_Cible.Cells.Clear
     'Formule dans la première cellule
     Sh_Cible.[A1].Formula = Formule
     'Extension de la formule si nécessaire
     If NbLgn > 1 Then Sh_Cible.[A1].AutoFill Destination:=Sh_Cible.[A1].Resize(NbLgn), Type:=xlFillDefault
     If NbCol > 1 Then Sh_Cible.[A1].Resize(NbLgn).AutoFill Destination:=Sh_Cible.[A1].Resize(NbLgn, NbCol), Type:=xlFillDefault
     'Remplacer les formules par les valeurs
     Sh_Cible.[A1].Resize(NbLgn, NbCol).Value = Sh_Cible.[A1].Resize(NbLgn, NbCol).Value
     'Activer la feuille cible
     Application.Goto Sh_Cible.[A1], True
    
     Application.ScreenUpdating = True
     Set FSO = Nothing
     Set Bouton = Nothing

End Sub