Copier la feuille d'un classeur fermé vers un classeur ouvert
Bonjour à tous,
Dans le cadre d'un projet d'entreprise, je souhaite copier la feuille d'un classeur fermé et la coller dans une nouvelle feuille d'un classeur ouvert (celui depuis lequel j'exécute ma macro). Je suis déjà aller voir sur internet mais impossible de trouver quelque chose qui fonctionne ..
Voici mon code :
Sub RequeteClasseurFerme()
Dim Cn As ADODB.Connection
Dim Fichier As String
Dim NomFeuille As String, texte_SQL As String
Dim Rst As ADODB.Recordset
'Définit le classeur fermé servant de base de données
Fichier = "E:/INSA - GCE/Projet méthode/Documents internes/Tableau de sélection de matériels/00A001 - Test 1/03 - DOSSIER MATERIELS/Tableau de sélection de matériels.xlsm"
'Nom de la feuille dans le classeur fermé
NomFeuille = "Feuil1"
Set Cn = New ADODB.Connection
'--- Connection ---
With Cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & Fichier & _
";Extended Properties=Excel 8.0;"
.Open
End With
'-----------------
'Définit la requête.
'/!\ Attention à ne pas oublier le symbole $ après le nom de la feuille.
texte_SQL = "SELECT * FROM [Feuille de mission$]"
Set Rst = New ADODB.Recordset
Set Rst = Cn.Execute(texte_SQL)
'Ecrit le résultat de la requête dans la cellule A1
Range("A1").CopyFromRecordset Rst
'--- Fermeture connexion ---
Cn.Close
Set Cn = Nothing
End Sub
Lorsque j'exécute celui-ci, j'ai une erreur (Erreur de complilation : Type défini par l'utilisateur non défini) et je ne sais pas pourquoi de plus, ma première ligne se surligne :
Cn As ADODB.Connection
J'attend vos réponses avec impatience !
Petite mise à jour :
J'ai activé la référence Microsoft ActiveX Data Objects x.x Library et je n'ai plus l'erreur sur ma première ligne, par contre, maintenant j'ai une autre erreur : "Erreur d'exécution '-2147467259 (80004005)' : Erreur Automation Erreur non spécifiée)
Quelqu'un aurait une idée ?
Bonjour,
Plusieurs points :
* Jet c'est un peu ancien, on peut utiliser MSDASQL
* Cn.Execute => c'est à préférer pour les requêtes du genre Insert, Update, Delete. Pour un Select, un Open suffit
* enfin ici en liaison tardive, inutile de s'embêter avec les références.
Voici une proposition de code :
Sub RequeteClasseurFerme()
Dim Cn As Object, Rst As Object
Dim Fichier As String, texte_SQL As String
Dim j As Integer
Fichier = "E:/INSA - GCE/Projet méthode/Documents internes/Tableau de sélection de matériels/00A001 - Test 1/03 - DOSSIER MATERIELS/Tableau de sélection de matériels.xlsm"
Set Cn = CreateObject("ADODB.Connection")
Cn.Provider = "MSDASQL"
Cn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
"DBQ=" & Fichier & "; ReadOnly=False;"
texte_SQL = "SELECT * FROM [Feuille de mission$]"
Set Rst = CreateObject("ADODB.Recordset")
Rst.Open texte_SQL, Cn, 3
With ActiveSheet
For j = 1 To Rst.Fields.Count ' =>les entêtes
.Cells(1, j) = Rst.Fields(j - 1).Name
Next j
.Range("A2").CopyFromRecordset Rst ' =>les données
End With
Cn.Close
Set Rst = Nothing
Set Cn = Nothing
End Sub
Pierre
edit :
PS : on peut rendre ce code un peu plus "générique" pour pouvoir l'utiliser plusieurs fois dans une même appli :
Sub Exemple_d_appel()
Dim Fichier As String, Feuil As String, Destination As String
Fichier = "E:/INSA - GCE/Projet méthode/Documents internes/Tableau de sélection de matériels/00A001 - Test 1/03 - DOSSIER MATERIELS/Tableau de sélection de matériels.xlsm"
Feuil = "Feuille de mission"
Destination = "Feuil1"
RequeteClasseurFerme Fichier, Feuil, Destination
End Sub
Sub RequeteClasseurFerme(Fichier As String, Feuil As String, Destination As String)
Dim Cn As Object, Rst As Object, j As Integer
Set Cn = CreateObject("ADODB.Connection")
Cn.Provider = "MSDASQL"
Cn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
"DBQ=" & Fichier & "; ReadOnly=False;"
Set Rst = CreateObject("ADODB.Recordset")
Rst.Open "SELECT * FROM [" & Feuil & " $]", Cn, 3
With Sheet(Destination)
For j = 1 To Rst.Fields.Count ' =>les entêtes
.Cells(1, j) = Rst.Fields(j - 1).Name
Next j
.Range("A2").CopyFromRecordset Rst ' =>les données
End With
Cn.Close
Set Rst = Nothing
Set Cn = Nothing
End Sub
Cool merci, ça fonctionne ! Par contre, il y a juste un problème, dans les cases B1 à N1, il me met des valeurs (F2 à F14) alors qu'il n'y a rien dans mon classeur fermé, sais-tu pourquoi ?
Bonjour,
La question est intéressante.
Pour rappel, le fonctionnement ordinaire d'Excel est de faire au mieux des ordres donnés et au mieux de ce qu'il trouve.
Dans le cas de ce type de requête : "SELECT * FROM [Feuille de mission$]"
, Excel va chercher dans cet onglet toute info qui ressemble à des données quelconques ... et même si elles ont été effacées!
Dans ton cas, il se peut qu'il y ait eu des saisies dans les colonnes B à N, secondairement effacées mais dans le doute Excel traite ces colonnes quand même.
Pour éviter ces info inutiles, plusieurs méthodes possibles :
1/ La méthode "Bourin" : je connais les entêtes pertinentes, je les saisis en ligne 1, et dans le code j'efface la boucle For j = 1 To Rst.Fields.Count
C'est simple, mais si le fichier de données comporte beaucoup de lignes et de colonnes, on perd du temps pour rien. A éviter.
2/ La méthode "Ceinture" : je restreins les colonnes à lire dans la clause FROM de la requête Sql.
Ici par exemple pour limiter aux colonnes de A à C :
"SELECT * FROM [Feuille de mission$A:C]"
Rq : si on veut on peut aussi limiter le nombre de lignes, par exemple =>
[Feuille de mission$A1:C100]
3/ La méthode "Bretelles" : je restreins les colonnes à lire en spécifiant nommément les entêtes :
"SELECT Id, Materiel FROM [Feuille de mission$]"
(en supposant qu'il y ait 2 entêtes `Id` et `Materiel` dans le fichier de données)
Cette méthode suffit la plupart du temps.
Rq : /!\ si une entête est un mot composé, par exemple `Date de péremption`, il est nécessaire d'entourer l'entête de `guillemets-du-7` (ALT-Gr + 7 2 fois puis backspace) et non pas 'guillemets-du-4'. Soit :
"SELECT Id, Materiel, `Date de péremption` FROM [Feuille de mission$]"
4/ La méthode "Ceinture ET Bretelles" : je combine les 2 restrictions précédentes :
"SELECT Id, Materiel FROM [Feuille de mission$A:C]"
C'est la plus rapide d'exécution en cas de fichier de données imposant (de plusieurs gigas).
- Ah mais, donc on peut moduler le texte de la requête?
- Et oui, et c'est là tout l'intérêt de la méthode, le SELECT est une commande en langage SQL, et on peut tout à fait écrire des requêtes plus complexes en utilisant les possibilités du SQL (et c'est très puissant!)
Req = "SELECT MAX(V.Date_visite), M.Freq, R.Responsable, M.Id, M.Denomination, " & _
" M.Reference, M.Emplacement, M.Batiment, M.Etage, M.Info1 " & _
" FROM ([" & Materiel & "$] AS M " & _
" LEFT JOIN [" & Verif & "$] AS V ON M.Id=V.Id)" & _
" LEFT JOIN [" & Responsables & "$] AS R ON R.Id_Resp=M.Id_Resp" & _
" WHERE (dateadd('m',12/M.freq, V.Date_visite)<=" & CLng(Date) & _
" OR V.Date_visite>=" & derJ & _
" OR ISNULL(V.Date_visite)) " & _
" AND M.Id_Resp=" & Filtre & _
" GROUP BY M.Freq, R.Responsable, M.Id, M.Denomination, M.Reference, M.Emplacement, " & _
" M.Batiment, M.Etage, M.Info1 " & _
" ORDER BY MAX(V.Date_visite) ASC, M.Denomination ASC"
Là en l’occurrence le résultat de cette requête est placée dans un "Array" pour traiter rapidement les info recueillies secondairement.
En conclusion : le SQL, c'est bon, mangez-en!
Pierre
PS : LA Source à avoir dans ses favoris/marque-pages : http://sql.sh/
Oh excellent merci ! Je vais pouvoir me débrouiller avec tous ça !!
Bonjour,
Plusieurs points :
* Jet c'est un peu ancien, on peut utiliser MSDASQL
* Cn.Execute => c'est à préférer pour les requêtes du genre Insert, Update, Delete. Pour un Select, un Open suffit
* enfin ici en liaison tardive, inutile de s'embêter avec les références.
Voici une proposition de code :
Sub RequeteClasseurFerme() Dim Cn As Object, Rst As Object Dim Fichier As String, texte_SQL As String Dim j As Integer Fichier = "E:/INSA - GCE/Projet méthode/Documents internes/Tableau de sélection de matériels/00A001 - Test 1/03 - DOSSIER MATERIELS/Tableau de sélection de matériels.xlsm" Set Cn = CreateObject("ADODB.Connection") Cn.Provider = "MSDASQL" Cn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _ "DBQ=" & Fichier & "; ReadOnly=False;" texte_SQL = "SELECT * FROM [Feuille de mission$]" Set Rst = CreateObject("ADODB.Recordset") Rst.Open texte_SQL, Cn, 3 With ActiveSheet For j = 1 To Rst.Fields.Count ' =>les entêtes .Cells(1, j) = Rst.Fields(j - 1).Name Next j .Range("A2").CopyFromRecordset Rst ' =>les données End With Cn.Close Set Rst = Nothing Set Cn = Nothing End Sub
Pierre
edit :
PS : on peut rendre ce code un peu plus "générique" pour pouvoir l'utiliser plusieurs fois dans une même appli :
Sub Exemple_d_appel() Dim Fichier As String, Feuil As String, Destination As String Fichier = "E:/INSA - GCE/Projet méthode/Documents internes/Tableau de sélection de matériels/00A001 - Test 1/03 - DOSSIER MATERIELS/Tableau de sélection de matériels.xlsm" Feuil = "Feuille de mission" Destination = "Feuil1" RequeteClasseurFerme Fichier, Feuil, Destination End Sub Sub RequeteClasseurFerme(Fichier As String, Feuil As String, Destination As String) Dim Cn As Object, Rst As Object, j As Integer Set Cn = CreateObject("ADODB.Connection") Cn.Provider = "MSDASQL" Cn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _ "DBQ=" & Fichier & "; ReadOnly=False;" Set Rst = CreateObject("ADODB.Recordset") Rst.Open "SELECT * FROM [" & Feuil & " $]", Cn, 3 With Sheet(Destination) For j = 1 To Rst.Fields.Count ' =>les entêtes .Cells(1, j) = Rst.Fields(j - 1).Name Next j .Range("A2").CopyFromRecordset Rst ' =>les données End With Cn.Close Set Rst = Nothing Set Cn = Nothing End Sub
Bonsoir Pierre j'ai le même soucis que Calitek. J'ai copier ton codes pour le réadapter à mon fichier mais j'ai des messages d'erreur
Quand j'active le Microsoft ActiveX Data Objects x.x Library
En validant il met met ''Nom de module, de projet ou de bibliothèque déjà utilisé "
J'utilise Excel 2016
le code que j'ai coller et remplacer le chemin
Sub Exemple_d_appel()
Dim Fichier As String, Feuil As String, Destination As String
Fichier = "C:\Users\amouedraogo\Desktop\Macro\Analyse technique.xlsm"
Feuil = "Base de données cours"
Destination = "Base de données cours"
RequeteClasseurFerme Fichier, Feuil, Destination
End Sub
Sub RequeteClasseurFerme(Fichier As String, Feuil As String, Destination As String)
Dim Cn As Object, Rst As Object, j As Integer
Set Cn = CreateObject("ADODB.Connection")
Cn.Provider = "MSDASQL"
Cn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
"DBQ=" & Fichier & "; ReadOnly=False;"
Set Rst = CreateObject("ADODB.Recordset")
Rst.Open "SELECT * FROM [" & Basededonnescours & " $]", Cn, 3
With Sheet(Destination)
For j = 1 To Rst.Fields.Count ' =>les entêtes
.Cells(1, j) = Rst.Fields(j - 1).Name
Next j
.Range("A2").CopyFromRecordset Rst ' =>les données
End With
Cn.Close
Set Rst = Nothing
Set Cn = Nothing
End Sub
Merci de m'aider
Déjà, c'est inutile d'activer des références supplémentaires (et contre productif).
Plutôt que des explications, voici une démo avec lecture xls et accdb via ADO
Pierre
Déjà, c'est inutile d'activer des références supplémentaires (et contre productif).
Plutôt que des explications, voici une démo avec lecture xls et accdb via ADO
Pierre
Bonjour Pierre
J'ai essayé de comprendre le mécanisme de la demo fournie mais
Plus clairement je vourdrais copier les données de la feuille "Base de données cours" du fichier fermé 'Analyse technique finale.xlm dont l'adresse est C:\Users\amouedraogo\Desktop\Macro\Analyse technique\Analyse technique finale.xlm vers la feuille "Base de données cours" du classeur ouvert "Evaluation.xlm"
Voici les fichiers en question
Please si tu peux bien m'aider
1/ Attention au nom de fichier : Analyse technique finale .xlsm
n'est pas Analyse technique finale.xlsm
=> cf espace avant le point
2/ Je ne sais pas quel est ce p$*!n de format de fichier, mais en copiant/collant les données dans un fichier neuf nommé Analyse technique finale.xlsm
, onglet Base de données cours
le code fonctionne sans problème.
3/ Si les données commencent en ligne 3, il faut l'indiquer dans la requête
Voir fichier démo => en modifiant dans le code le chemin du nouveau fichier Analyse technique finale.xlsm
(sans espace avant le point)
Pierre
1/ Attention au nom de fichier :
Analyse technique finale .xlsm
n'est pasAnalyse technique finale.xlsm
=> cf espace avant le point2/ Je ne sais pas quel est ce p$*!n de format de fichier, mais en copiant/collant les données dans un fichier neuf nommé
Analyse technique finale.xlsm
, ongletBase de données cours
le code fonctionne sans problème.3/ Si les données commencent en ligne 3, il faut l'indiquer dans la requête
Voir fichier démo => en modifiant dans le code le chemin du nouveau fichier
Analyse technique finale.xlsm
(sans espace avant le point)Pierre
Super
Merci à toi Pierre
1/ Attention au nom de fichier :
Analyse technique finale .xlsm
n'est pasAnalyse technique finale.xlsm
=> cf espace avant le point2/ Je ne sais pas quel est ce p$*!n de format de fichier, mais en copiant/collant les données dans un fichier neuf nommé
Analyse technique finale.xlsm
, ongletBase de données cours
le code fonctionne sans problème.3/ Si les données commencent en ligne 3, il faut l'indiquer dans la requête
Voir fichier démo => en modifiant dans le code le chemin du nouveau fichier
Analyse technique finale.xlsm
(sans espace avant le point)Pierre
Bonjour Pierre
j'ai remarqué ce matin que la copie s'arrête à la date du "01/06/2017" colonne IU, pourtant on a bien définit la copie sur le fichier source (plage A3:BPQ57). Que dois je changer dans ton code pour qu'il prenne en compte le reste des données?
Bon weekend à toi !!
En effet j'aurai du y penser, avec excel le Sql est limité à 255 colonnes max.
Par ailleurs, ici les données sont organisées de façon inhabituelles, il est plus classique d'avoir des données journalières en lignes (et non pas en colonnes).
Avec cette présentation de données, il faut oublier cette méthode.
A la réflexion, avec une boucle ça passe.
C'est pas très académique, mais bon...
(Le chemin du fichier est toujours à mettre à jour)
Pierre
' ***********************************************************************
' ***** *****
' ***** CODE PierreP56 : http://tatiak.canalblog.com/ *****
' ***** *****
' ***********************************************************************
Sub Exemple_d_appel()
Dim Fichier As String, Dt As String
Dim Dest As Range, cl As Long, Jr As Integer
'Fichier = "C:\Users\amouedraogo\Desktop\Macro\Analyse technique.xlsm"
Fichier = "D:\Xl\Forum\Analyse technique finale.xlsm"
Application.ScreenUpdating = False
With Sheets("Base de données cours")
.UsedRange.ClearContents
Jr = 254
RequeteClasseurFerme Fichier, .Cells(1, 1), Jr
Dt = "0"
Do While CDate(Dt) <= Format(Date, "dd/mm/yyyy")
cl = .Cells(1, Columns.Count).End(xlToLeft).Column
Set Dest = .Cells(1, cl + 1)
Dt = Format(DateAdd("d", Jr, CDate(Dest.Offset(0, -1).Value)), "dd/mm/yyyy")
If CDate(Dt) >= Date Then Jr = CDate(Dt) - Date
RequeteClasseurFerme Fichier, Dest, Jr
Loop
End With
Set Dest = Nothing
Application.ScreenUpdating = True
End Sub
Sub RequeteClasseurFerme(Fichier As String, Dest As Range, Jr As Integer)
Dim Cn As Object, Rst As Object, Adr As String, Req As String, j As Long
Set Cn = CreateObject("ADODB.Connection")
Cn.Provider = "MSDASQL"
Cn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
"DBQ=" & Fichier & "; ReadOnly=False;"
Set Rst = CreateObject("ADODB.Recordset")
On Error Resume Next
Adr = Replace(Dest.Offset(2, 0).Address & ":" & Dest.Offset(56, Jr).Address, "$", "")
Req = "SELECT * FROM [Base de données cours$" & Adr & "]"
Rst.Open Req, Cn, 3
With Dest
For j = 1 To Rst.Fields.Count ' =>les entêtes
.Offset(0, j - 1).Value = CDate(Rst.Fields(j - 1).Name)
Next j
.Offset(1, 0).CopyFromRecordset Rst ' =>les données
End With
Cn.Close
Set Rst = Nothing
Set Cn = Nothing
End Sub
Bonjour messieurs,
Je suis vos échanges avec la plus grande attention pour éviter la redite (mais j'ai tout de même fait un sujet par ailleurs pour mon problème ici). J'ai une petite expérience en VBA et suis également entrain de me mettre à ADO.
Je suis un peu chafouin parce que j'ai testé les fichiers proposés par pierrep56, mais ça ne fonctionne pas chez moi. Comme dit en Late Binding, ça ne doit pas être un problème de référence, donc je sèche !
Une idée messieurs ?
1/ Attention au nom de fichier :
Analyse technique finale .xlsm
n'est pasAnalyse technique finale.xlsm
=> cf espace avant le point2/ Je ne sais pas quel est ce p$*!n de format de fichier, mais en copiant/collant les données dans un fichier neuf nommé
Analyse technique finale.xlsm
, ongletBase de données cours
le code fonctionne sans problème.3/ Si les données commencent en ligne 3, il faut l'indiquer dans la requête
Voir fichier démo => en modifiant dans le code le chemin du nouveau fichier
Analyse technique finale.xlsm
(sans espace avant le point)Pierre
Bonjour à tous,
C'est un problème connu avec le format xlsb
ADO ne fonctionne que si le xlsb est ouvert
Pour lecture d'un fichier fermé, préférer le format xlsx ou xlsm
Pierre
Bonjour Pierre merci beaucoup pour ton aide. Cela fonctionne bien. je vais changer le format d'affichage des données du format source ou a défaut ajouter un code pour coller en transposer (date en ligne et titre en colonne).
Bonjour à tous,
C'est un problème connu avec le format xlsb
ADO ne fonctionne que si le xlsb est ouvert
Pour lecture d'un fichier fermé, préférer le format xlsx ou xlsm
Pierre
Merci Pierrep56 pour tes réponses. J'ai d'ailleurs clôturé mon sujet. Mais ça ne répond pas à la problématique que j'ai soulevée ici.
J'exécute le code que tu as proposé à bidexcel un peu plus haut (ici) en cliquant sur le bouton que tu as prévu. Et voici l'erreur que ça me remonte :
Je continue à chercher mais ne trouve pas l'explication.