Re : pb lier 2 fichiers excel
Un exemple de macro de transfert de données d'un fichier fermé vers un fichier ouvert dans lequel se trouve la macro de commande.
Dans cette macro, plusieurs requêtes ADO permettent le report des données utiles.
Option Explicit
Public Chemin As String, Derlig As Long, Tablo
Sub ExtractionFindings()
'/!\ Références à installer par le menu Outils/Reférences
' Visual Basic For Applications
' Microsoft Excel 12.0 Object Library
' OLE Automation
' Microsoft Office 12.0 Object Library
' Microsoft Forms 2.0 Object Library
' Shockwava Flash
' Microsoft ActiveX Data Objects 2.1 Library
' Microsoft ADO Ext. 2.8 for DDL and Security
Dim Source As ADODB.Connection, Rst As ADODB.Recordset, ADOCommand As ADODB.Command
Dim Fichier As String, Cellule As String, Feuille As String
Application.Calculation = xlManual
Application.ScreenUpdating = False
' Effacement de la base précédente
With Sheets("Work Order")
Derlig = .Range("I65536").End(xlUp).Row
With .Range("A2:V" & Derlig + 1)
.ClearContents
.Interior.ColorIndex = xlNone
.Borders.LineStyle = xlLineStyleNone
End With
End With
'Définit le classeur fermé servant de base de données
Fichier = Chemin & "\" & "findings.xls"
'Nom de la feuille dans le classeur fermé ne pas oublier d'ajouter $ au nom de la feuille.
Feuille = "Work Order$"
'--- Connexion ---
Set Source = New ADODB.Connection
Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=NO;IMEX=1"""
'-Définit la requête---
Cellule = "A2:B20000" 'Adresse des cellules contenant les données à récupérer
Set ADOCommand = New ADODB.Command
With ADOCommand
.ActiveConnection = Source
.CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
End With
'Reference
Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
Sheets("Work Order").Range("A2").CopyFromRecordset Rst
'---Définit la nouvelle requête---
Cellule = "C2:F20000" 'Adresse des cellules contenant les données à récupérer
ADOCommand.CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
'Reference
Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
Sheets("Work Order").Range("D2").CopyFromRecordset Rst
'---Définit la nouvelle requête---
Cellule = "G2:L20000" 'Adresse des cellules contenant les données à récupérer
ADOCommand.CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
'Reference
Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
Sheets("Work Order").Range("I2").CopyFromRecordset Rst
'---Définit la nouvelle requête---
Cellule = "M2😛20000" 'Adresse des cellules contenant les données à récupérer
ADOCommand.CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
'Reference
Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
Sheets("Work Order").Range("R2").CopyFromRecordset Rst
' Fermeture des variables
Rst.Close
Source.Close
Set Source = Nothing
Set Rst = Nothing
Set ADOCommand = Nothing
Application.Calculation = xlAutomatic
End Sub
Macro testée sous Excel 2007 et 2013.
Des mises en forme peuvent être ensuite nécessaires...