Sub TestConso()
Dim Fich1$, Fich2$, Source1$, Source2$, Cible$
Fich1 = "H:\Support PES\Analyse des erreurs\rraf005\Data\Tableau de saisie des serveurs.xls_du_20111028_au_20111028_genere_20111028_074137.xlsx"
Fich2 = "H:\Support PES\Analyse des erreurs\rraf005\Data\Tableau de saisie des serveurs.xls_du_20111003_au_20111003_genere_20111003_083337.xlsx"
Source1 = "Feuil2"
Source2 = "Feuil2"
Cible = "Feuil2"
ConsoDatas Fich1, Source1, Cible
ConsoDatas Fich2, Source1, Cible
End Sub
Public Sub ConsoDatas(NomFichier$, FeuilleSource$, FeuilleCible$)
'Va chercher dans le classeur NomFichier (sans l'ouvrir) les données
'de la feuille FeuilleSource et les copie dans la feuille FeuilleCible
'du classeur actif, à la suite des données (éventuellement) déjà présentes.
'(La ligne d'entêtes de FeuilleSource n'est pas importée)
'inspiré de Rob Bovey, mpep
'nécessite une référence à la librairie
'Microsoft ActiveX Data Object 2.x Library
Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim Li&, FeuilleDest
''' Crée la chaîne de connexion
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & NomFichier & ";" & _
"Extended Properties=Excel 8.0;"
' La requête est basée sur le nom de la feuille. Ce nom
' doit se terminer par un $ et doit être entouré de crochets droits.
szSQL = "SELECT * FROM [" & FeuilleSource & "$];"
Set rsData = New ADODB.Recordset
rsData.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
'où envoyer les données :
Set FeuilleDest = ActiveWorkbook.Sheets(FeuilleCible)
Li = FeuilleDest.Range("A65536").End(xlUp).Row + 1
'envoi sur la première ligne vide
If Not rsData.EOF Then
FeuilleDest.Range("A" & Li).CopyFromRecordset rsData
Else
'si la source était vide...
MsgBox "Aucun enregistrement renvoyé.", vbCritical
End If
''' On nettoie pour finir...
rsData.Close
Set rsData = Nothing
End Sub