Copier un range d'un classeur fermé

[tchangy71]

Bonjour,

Après une recherche sur internet je n'arrive pas a trouver ce que je souhaite. Je me permet donc de formuler ma demande sur ED en espérant ne pas poster un sujet redondant.

Voila je souhaite copier un range d'un classeur fermé pour copier les valeurs dans le classeur contenant la macro.

J'utilise actuellement la fonction WorkbooksOpen mais dans un souci de gain de temps je voulais savoir comment faire pour récupérer cette valeur sans ouvrir le classeur.

Voici a peu près la configuration de mon code actuel :

Workbooks.Open Filename:=sd.Range("B1") & sd.Cells(b, 1) & "\" & sd.Cells(a, 3) & "\recapitulatif_travaux_lieu.xlsm"
ActiveWorkbook.Sheets("donnees").Range(("B" & c & ":E" & c)).Copy
Sg.Cells(d, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.close ...

Merci d'avance pour votre aide,

Cordialement,
Philippe

 

[tchangy71]

Re : Copier un range d'un classeur fermé

J'ai oublier de préciser que je fais une boucle (while/wend) sur ce morceau de code !!

 

[flyonets44]

Re : Copier un range d'un classeur fermé

Bonjour
si ta plage de données à importer est volumineuse, il est à mon sens beaucoup plus rapide d'ouvrir le fichier et
de passer par un tableau; voici un code que j'utilise pour 40 000 lignes et 110 colonnes!
Public Sub Importer()
' COPIER LES DATAS DANS UNE FEUILLE DE CE CLASSEUR
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Vb1 As Variant, Vb2 As Variant, Wab As Workbook
Dim WSSource As Worksheet, WSobjectif As Worksheet, Source As String
Feuil1.Activate ' feuille de depart de ce classeur
Dossier_actuel
Set Wab = ActiveWorkbook
Set WSobjectif = Feuil3 ' qui recoit les datas
Vb1 = ThisWorkbook.Path & "\"
Vb2 = Feuil5.Range("F3").Value 'le nom du fichier à ouvrir
If Vb1 = vbNullString Then
Exit Sub
End If
If Vb2 = vbNullString Then
Exit Sub
End If
'OUVERTURE FICHIER SOURCE
Z = 1
Workbooks.Open Filename:=Vb1 & Vb2, UpdateLinks:=0
Source = ActiveWorkbook.Name
Workbooks(Source).Activate
Set WSSource = Workbooks(Source).Worksheets(Z)
'SELECTION FEUILLE SOURCE
WSSource.Activate
'POSITIONNEMENT DANS LA FEUILLE
Cells(1, 1).Select
Tablo = ActiveSheet.Cells(1, 1).Resize(Dlign, Dcol).Value
Y = 1 + Range("A65536").End(xlUp).Row
ActiveWorkbook.Close
Feuil3.Activate
Cells(1, 1).Select
ActiveSheet.Cells(1, 1).Resize(Dlign, Dcol).Value = Tablo
Erase Tablo
Set WSSource = Nothing: Set Wab = Nothing: Set WSobjectif = Nothing
Application.Calculation = xlCalculationAutomatic
End Sub
Cordialement
Flyonets

 

[tchangy71]

Re : Copier un range d'un classeur fermé

Bonjour flyonets44,

Merci pour cette réponse.

En faite je n'ai pas autant de ligne que toi à copier dans le(s) classeur(s) fermé(s) (Varie entre une dizaine de lignes et au maximum une centaine)

De plus ces classeurs sont enregistrés sur un backup en réseau, ce qui entraine donc à chaque ouverture/fermeture un temps d'attente non négligeable. Que je souhaiterais supprimer.

J'ai trouvé un lien vers une solution réalisé par MichelXLD :
https://www.excel-downloads.com/threads/feuilles-dun-classeur-ferme-vers-le-classeur-acti.60415/

Mais je n'arrive pas à l'appliquer. Il me semble qu'il y as des problème de guillemet !!

Voila comment j'ai essayé de l'utiliser (dans une classeur test) :

Sub requeteFeuilleClasseurFerme()
'
'necessite d'activer la reference Microsoft ActiveX Data Objects x.x Library
'
'J'AI BIEN ACTIVER LES REFERENCE MICROSOFT ACTIVEX DATA OBJECT 6.0 LIBRARY
Dim Source As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim nomFeuille As String, fichier As String, texte_SQL As String
Dim i As Integer

nomFeuille = "Feuil1"
fichier = "C:\Users\ph\Desktop\Classeur1.xlsm"

Set Source = New ADODB.Connection
ET CI DESSOUS J'AI LE MESSAGE D'ERREUR : Erreur d'exécution '-2147467259 (80004005)': ...

Source.Open 'Provider = Microsoft.Jet.OLEDB.4.0;' & _
'data source=' & fichier & ';extended properties=''Excel 8.0;'''

texte_SQL = "SELECT * FROM [' & nomFeuille & '$]"

Set Rst = New ADODB.Recordset
Set Rst = Source.Execute(texte_SQL)

For i = 1 To Rst.Fields.Count
Cells(1, i) = Rst.Fields(i - 1).Name
Next i

Sheets(nomFeuille).Range("A2").CopyFromRecordset Rst 'import des données

Rst.Close
Source.Close
End Sub

Si quelqu'un as une solution !!

Merci d'avance.

 

[tchangy71]

Re : Copier un range d'un classeur fermé

Bon après divers recherche j'ai pus solutionner les problèmes de guillemets mais je me rend compte que le code ne marche pas (enfin sur mon poste)

Sur un tuto j'ai trouvé comment se connecter simplement à un classeur (uniquement la connexion) mais la non plus ça ne marche pas !!

Voici le code :
Sub TestConnection_V1()
Dim Cn As ADODB.Connection
Dim Fichier As String

'Définit le classeur fermé servant de base de données
Fichier = "C:\Users\ph\Desktop\Classeur1.xlsm"

Set Cn = New ADODB.Connection

'--- Connexion ---
With Cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & Fichier & _
";Extended Properties=Excel 8.0;"
.Open 'Ici j'ai le message d'erreur : Erreur d’exécution '3706': Erreur définie par l’application ou par l'objet
End With

'Extended Properties=Excel 8.0 est utilisé pour les versions d'Excel 97, 2000 et 2002.

'
'... la requête ...
'

'--- Fermeture connexion ---
Cn.Close
Set Cn = Nothing
End Sub

Voici les références disponible :
Visual Basic For Application
Microsoft Excel 14.0 Object Library
OLE Automation
Microsoft Office 14.0 Object Library
Microsoft Acrive X Data Objets 6.0 Library
Microsoft Acrive X Data Objets (multi-dimensional) 2.8 library

Perso je sèche !!

Merci, Phil

 

[BOISGONTIER]

Re : Copier un range d'un classeur fermé

Bonjour,

Sub RecupTableur2()
  ' Microsoft ActiveX DataObject doit être coché
  Set cnn = New ADODB.Connection
  répertoire = ThisWorkbook.Path & "\"
  cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & répertoire & "ADOsource.xls"
  nomfeuille = "Feuil1"
  Set rs = cnn.Execute("[" & nomfeuille & "$A1:M100]")
  [A2].CopyFromRecordset rs
  rs.Close
  cnn.Close
  Set rs = Nothing
  Set cnn = Nothing
End Sub

ADO

JB

 

[tchangy71]

Re : Copier un range d'un classeur fermé

Bonjour ,

A la ligne : cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & répertoire & "ADOsource.xls"
J'ai l'erreur : Erreur d'exécution '-2147467259 (80004005)': Erreur Automation Erreur non spécifiée

A vrai dire je ne comprend pas bien le code !! Ou est ce que j'initialise le nom du classeur à rechercher ?

 

[Softmama]

Re : Copier un range d'un classeur fermé

Bonjour Tchangy, JB,

une autre façon de faire, simple à mettre en oeuvre, par macro (qui place des formules avec des liens) sur la plage A1:AA100 sans ADO et sans ouvrir le fichier :

Sub Macro1()
application.screenupdating=false
    [A1].Formula = "='C:\Users\ph\Desktop\[Classeur1.xlsm]Feuil1'!A1"  'Récup° de la cellule A1, feuille1
    [A1].AutoFill [A1:AA1]  'Récupération de la première ligne
    [A1:AA1].AutoFill [A1:AA100] 'Récupération des 100 lignes
' Pour ne pas conserver le lien avec le fichier d'origine placer cette ligne :
'Range("A1:AA100").value = Range("A1:AA100").value
application.screenupdating=true
End Sub

 

[tchangy71]

Re : Copier un range d'un classeur fermé

Bonjour et merci Softmama,

Ce morceau de code est très intéressant mais est il possible de boucler et vérifier la valeur de cette dernière ?

Du type :
ligne_lue = 1
ligne_ecrite = 3
While Cells (ligne_lue, 1) <> ""
'où Cells (ligne_lue, 1) correspond à la valeur de la cellule A1 de "='C:\Users\ph\Desktop\[Classeur1.xlsm]Feuil1'!A1"
Cells (ligne_ecrite, 4).Formula = Cells (ligne_lue, 1)
ligne_lue = ligne_lue + 1
ligne_ecrite = ligne_ecrite + 1
Wend

 

[Softmama]

Re : Copier un range d'un classeur fermé

Heu, oui tu dois pouvoir adapter ainsi (à tester) :

Sub Macro1()
application.screenupdating=false
    [A1].Formula = "='C:\Users\ph\Desktop\[Classeur1.xlsm]Feuil1'!A1"  'Récup° de la cellule A1, feuille1
   [A1].AutoFill [A1:AA1]  'Récupération de la première ligne
   for t = 1 to 10000 '10000 : maximum de lignes à récupérer, à adapter
    range("A" & t & ":AA" & t).AutoFill range("A" & t & ":AA" & t+1) 'Récupération de la ligne suivante
    if cells(t+1,1)=0 then cells(t+1,1).entirerow.Clear :exit for 'Si la cellule = 0 (cellule du fichier source vide) alors on sort de la boucle
   next t
' Pour ne pas conserver le lien avec le fichier d'origine placer cette ligne :
'Range("A1:AA" & t-1).value = Range("A1:AA" & t-1).value
application.screenupdating=true
End Sub

 

[tchangy71]

Re : Copier un range d'un classeur fermé

Merci beaucoup

 

[froggystar69]

Re : Copier un range d'un classeur fermé

Bonjour flyonets44,

Merci pour cette réponse.

En faite je n'ai pas autant de ligne que toi à copier dans le(s) classeur(s) fermé(s) (Varie entre une dizaine de lignes et au maximum une centaine)

De plus ces classeurs sont enregistrés sur un backup en réseau, ce qui entraine donc à chaque ouverture/fermeture un temps d'attente non négligeable. Que je souhaiterais supprimer.

J'ai trouvé un lien vers une solution réalisé par MichelXLD :
https://www.excel-downloads.com/threads/feuilles-dun-classeur-ferme-vers-le-classeur-acti.60415/

Mais je n'arrive pas à l'appliquer. Il me semble qu'il y as des problème de guillemet !!

Voila comment j'ai essayé de l'utiliser (dans une classeur test) :

Sub requeteFeuilleClasseurFerme()
'
'necessite d'activer la reference Microsoft ActiveX Data Objects x.x Library
'
'J'AI BIEN ACTIVER LES REFERENCE MICROSOFT ACTIVEX DATA OBJECT 6.0 LIBRARY
Dim Source As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim nomFeuille As String, fichier As String, texte_SQL As String
Dim i As Integer

nomFeuille = "Feuil1"
fichier = "C:\Users\ph\Desktop\Classeur1.xlsm"

Set Source = New ADODB.Connection
ET CI DESSOUS J'AI LE MESSAGE D'ERREUR : Erreur d'exécution '-2147467259 (80004005)': ...

Source.Open 'Provider = Microsoft.Jet.OLEDB.4.0;' & _
'data source=' & fichier & ';extended properties=''Excel 8.0;'''

texte_SQL = "SELECT * FROM [' & nomFeuille & '$]"

Set Rst = New ADODB.Recordset
Set Rst = Source.Execute(texte_SQL)

For i = 1 To Rst.Fields.Count
Cells(1, i) = Rst.Fields(i - 1).Name
Next i

Sheets(nomFeuille).Range("A2").CopyFromRecordset Rst 'import des données

Rst.Close
Source.Close
End Sub

Si quelqu'un as une solution !!

Merci d'avance.

Salut a toi alors j'ai le meme souci
deja a nomFeuille = "Feuil1$" <= mettre le $ ca evite un erreur ( ne me demande pas pkoi je n'en sais rien )
ensuite ton excel c'est le combien ? 2007 2001 2013 ? car sans doute faudra t il changer le EXCEL 8.0 par 12.0 ( juste le chiffre )
et enfin as tu activer l'activeX microsoft ?

juste un apercu de mon code :

Sub connexionfichierferme()

Dim cnx As ADODB.Connection
Dim rst As ADODB.Recordset
Dim cmd As ADODB.Command
Dim cheminf, plage, nfeuille As String

'********* Info sur le fichier cible *********

plage = "A1:N1"
nfeuille = "Feuil1$"
cheminf = "F:\test.xlsx"

'********* Connexion sur le fichier cible *********

Set cnx = New ADODB.Connection
With cnx
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& cheminf & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1;"""
.Open
End With

'MsgBox "connexion effectuée sur le fichier : " & Mid(cheminf, 28, 34)

'********** Preparation de la commande SQL *********

Set cmd = New ADODB.Command
With cmd
.CommandText = "SELECT * FROM [" & nfeuille & plage & "]"
.CommandType = adCmdText
.ActiveConnection = cnx
End With

'********** Action de la commande SQL *********

Set rst = New ADODB.Recordset
With rst
.ActiveConnection = cnx
.Open cmd, , adOpenKeyset, adLockOptimistic
End With
Set rst = cnx.Execute("[" & nfeuille & plage & "]")
ThisWorkbook.Worksheets("Feuil1").Range("A1").CopyFromRecordset rst


'******** Fermeture de la connexion, de la command et du recordset du fichier cible *********

rst.Close
'cheminf.Close
cnx.Close
Set cnx = Nothing
Set cmd = Nothing
Set rst = Nothing

End Sub