copier une plage de cellules d'un classeur fermé dans un classeur ouvert

[yvann]

Bonjour à tous,

Voici mon problème: j'ai réussi à trouver un code pour me connecter à un classeur fermé, mais ce code récupère simplement une valeur pour la mettre dans une cellule de mon classeur ouvert.

Voici le code que j'ai adapté à ma situation:

Sub ConnectCLasseur(ConnectCL As Object, _
Fichier As String, _
Optional Rs)

Set ConnectCL = CreateObject("ADODB.Connection")
If Not IsMissing(Rs) Then
Set Rs = CreateObject("ADODB.Recordset")
End If

ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;IMEX= 2;"""
End Sub

Sub RecupValeur(Classeur As String, _
NomFeuille As String, _
Cellule As String, _
ValeurCellule)

Dim ConnectCL As Object
Dim Rs As Object


ConnectCLasseur ConnectCL, Classeur, Rs

With Rs
.CursorType = 1
.LockType = 3
.Open "SELECT * FROM `" & NomFeuille & "$" & _
Cellule & "` ", ConnectCL
ValeurCellule = .Fields(0).Value
End With

ConnectCL.Close
Set Rs = Nothing
Set ConnectCL = Nothing
End Sub


Sub Test()

Dim Retour
Dim Classeur As String
Dim NomFeuille As String
Dim Cellule As String

Classeur = "S:\DCG\DCG_Commun\CNCE-Rac\2009\Crédit\Barèmes RAC Crédits\2009\Barèmes 200904.xls"
NomFeuille = "BAREMES"
Cellule = "F4338:F4697"

On Error GoTo Fin

RecupValeur Classeur, _
NomFeuille, _
Cellule, _
Retour


If IsNull(Retour) Then
MsgBox "La cellule est vide !"
Else
MsgBox Retour

[B1:B360] = Retour

End If

Fin:
If Err.Number <> 0 Then
MsgBox "Erreur de fichier !"
End If

End Sub




Ce code me retourne une seule valeur de B1 à B360 alors que je voudrais les 360 valeurs différentes qu'il y a de F4338 à F4697.

J'ai essayé de faire une boucle mais je n'arrive pas à écrire Cellule sous la forme Cellule="A1:A1" avec un compteur dedans...
En effet, quand je met quelque chose du genre Cellule=" F& i :F&i " ça ne marche jamais même en essayant avec des parenthèses, des crochets, etc....

En résumé, pourriez-vous me donner soit une solution pour la boucle, soit me modifier le code pour que ça fasse un copier de F4338:F4697 de ma cible et coller en B1 dans ma destination?

Je galère depuis des heures...

Merci d'avance pour vos réponses!

Yvann

 

[idiomea]

Re : copier une plage de cellules d'un classeur fermé dans un classeur ouvert

ah moi cela fait 2 jours que j'attand pour a meme chose,
j'ai un code qui copie toute une colonne de tous les onglets de classeur ouvert
et j'aimerais le modifier pour que cela copie une colonne specifique (la L mais bon ^^) mais de tous les 1er onglets de tous les classeur presents dans le meme dossier.

je surveille donc les reponses apporté à ton sujet

voila moi le mien
https://www.excel-downloads.com/thr...es-donnees-les-unes-a-cote-des-autres.122286/


Guillaume

 

[Pierrot93]

Re : copier une plage de cellules d'un classeur fermé dans un classeur ouvert

Bonsoir Yvann, Guillaume

regarde ce lien, le code de MichelXLD devrait t'aider :

https://www.excel-downloads.com/threads/feuilles-dun-classeur-ferme-vers-le-classeur-acti.60415/

bonne soirée
@+

 

[Pierrot93]

Re : copier une plage de cellules d'un classeur fermé dans un classeur ouvert

Re

d'autres exemples dans la FAQ pour piloter des fichiers fermés, toujours de l'excellent MichelXLD :

https://www.excel-downloads.com/thr...iltres-variables-fichiers-fermes-acces.92374/

@+

 

[yvann]

Re : copier une plage de cellules d'un classeur fermé dans un classeur ouvert

Bonsoir à tous,

Merci beaucoup Pierrot pour ces précisions, ça m'a aidé à progresser mais je n'y suis pas encore.. J'y ai passé énormément de temps pourtant mais il y a quelque chose qui m'échappe. Voici mon nouveau code qui marche toujours pas:



Sub Test()
Dim ConnectCL As Object
Dim Fichier As String
Dim NomFeuille As String
Dim Rs As Object
Dim valeur As Range


Fichier = "S:\DCG\DCG_Commun\CNCE-Rac\2009\Crédit\Barèmes RAC Crédits\2009\Barèmes 200904.xls"
NomFeuille = "BAREMES"


Set Rs = CreateObject("ADODB.Recordset")
Set ConnectCL = CreateObject("ADODB.Connection")



ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;IMEX= 2;"""

With Rs
.CursorType = 1
.LockType = 3
.Open "SELECT * FROM `" & NomFeuille & "$" & _
Range("F4338:F4697") & "` ", ConnectCL
valeur = Selection
End With

Range("B1").CopyFromRecordset Rs


ConnectCL.Close
Set Rs = Nothing
Set ConnectCL = Nothing

End Sub


Est-ce que vous pourriez éventuellement tester avec deux fichiers tout simples en changeant juste ce qu'il y a en orange et me dire ce qui ne va pas?

Merci mille fois d'avance!!!

 

[Pierrot93]

Re : copier une plage de cellules d'un classeur fermé dans un classeur ouvert

Re

essaye ainsi, noms classeur et feuille à adapter, et plage de cellule :

ne pas oublier d'activer la reference Microsoft ActiveX Data Objects x.x Library

Option Explicit
'necessite d'activer la reference Microsoft ActiveX Data Objects x.x Library
Sub test()
Dim Source As ADODB.Connection, Rst As ADODB.Recordset, i As Integer
Dim ADOCommand As ADODB.Command, fichier As String, Cellule As String, Feuille As String
Cellule = "A1:B177"
Feuille = "NomFeuille"
fichier = "C:\mesdocuments\Excel\classeur.xls"
                
Set Source = New ADODB.Connection
Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & fichier & ";Extended Properties=""Excel 8.0;HDR=Yes;"";"
                
Set ADOCommand = New ADODB.Command
With ADOCommand
    .ActiveConnection = Source
    .CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
End With
                  
Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
                  
Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
    
Range("A2").CopyFromRecordset Rst
    
Rst.Close
Source.Close
Set Source = Nothing
Set Rst = Nothing
Set ADOCommand = Nothing
End Sub

bonne soirée
@+

 

[yvann]

Re : copier une plage de cellules d'un classeur fermé dans un classeur ouvert

Dim Source as ADODB.Connection ???
Depuis quand ADODB.Connection est un type reconnu?
Désolé mais je craque là. je plaisante mais ça marche tjrs pas super à cause de ça. Mais que ça soit clair: Pierrot je respecte ton savoir car sans toi je ne serai jamais allé aussi loin.
Bonne soirée à tous

 

[yvann]

Re : copier une plage de cellules d'un classeur fermé dans un classeur ouvert

Désolé Pierrot, je me suis trompé, le problème ne doit pas venir de là car en activant certains Microsoft Activ X data objects l'erreur de type ne s'affiche plus.
Par contre la macro ne marche pas et j'ai ça quand je la lance:


Erreur d'exécution: '-2147467259 (80004005)'
Erreur Automation
Erreur non spécifiée

 

[michel_m]

Re : copier une plage de cellules d'un classeur fermé dans un classeur ouvert

Bonsoir,

Il y a une contradiction entre la recherche dans une plage et la connexion avec des étiquettes (HDR=YES) (hdr=header=etiquette)
D'autre part, si tes données sont du m^me type (tout texte ou tout nombre), tu n'as pas besoin de IMEX

donc pour la connexion
ConnectCL.Open "Provider = Microsoft.Jet.OLEDB.4.0;" & _
"data source=" & fichier & ";" & _
"extended properties=""Excel 8.0;HDR=No;"";"

la solution proposée par Pierrot(bonsoir) est moins portable car elle oblige à aller cocher la référence ADO lorsque tu exportes ton appli. Il vaut lmieux, à mon avis prendre l'option "create objet"

Ci dessous proposition à adapter:

Sub extraire()
Dim Source As Object, Requete As Object
Dim Onglet As String, Plage As String, fichier As String
Dim Texte_SQL As String

'détermination de la plage à extraire
    fichier = "S:\DCG\DCG_Commun\CNCE-Rac\2009\Crédit\Barèmes RAC Crédits\2009\Barèmes 200904.xls"
    Onglet = "BAREMES" '
    Plage = "F4338:F4697"
  
'connexion ADO
Set Source = CreateObject("ADODB.Connection")
    Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "data source=" & fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
    
     'exerce la requete ADO sur les donnée à recopier
    Texte_SQL = "SELECT * FROM [" & Onglet & "$" & Plage & "]"
    Set Requete = CreateObject("ADODB.Recordset")
    Set Requete = Source.Execute(Texte_SQL)
      
 'restitue sur ton classeur 
    Range("B1").CopyFromRecordset Requete
      
'libère les pointeurs
Set Requete = Nothing
Set Source = Nothing
    
End Sub

forcément non testées, donc...

 

[yvann]

Re : copier une plage de cellules d'un classeur fermé dans un classeur ouvert

Génial! Merci beaucoup Pierrot et Michel!!
Tout est résolu pour cette discussion. Ca marche très bien.
A très bientôt pour de nouveaux défis...