Macro importer plage de donnée excel vers excel

boross3

XLDnaute Nouveau
Bonjour à tous,

J'ai un repertoire de fichiers excel dont chacun a une plage de cellule qui a le meme nom (donneestoexport) pour chaque fichier. Je cherche à faire une macro dans un fichier maitre, qui importerait cette plage de donnée pour chaque fichier du dossier.
Pour l'instant ma macro récupère le nom des fichiers du dossiers. Je n'arrive pas à automatiser l'importation de données externes.
Ci joint la macro :

Code:
Sheets("feuil1").Select
repertoire = "c:\mondossier"    
I = 2
nf = Dir(repertoire & "\*.xls")   
    Do While nf <> ""
    Cells(I, 1) = nf
    nf = Dir                                     
    I = I + 1
Loop
filetoopen = Range("A1").Value
While filetoopen <> ""
    With ActiveSheet.QueryTables.Add(Connection:=Array( _
        "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=""filetoopen" _
        , _
        ";Mode=Share Deny Write;Extended Properties=""HDR=NO;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet" _
        , _
        " OLEDB:Database Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet O" _
        , _
        "LEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Data" _
        , _
        "base=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
        ), Destination:=Range("F2"))
        .CommandType = xlCmdTable
        .CommandText = Array("donneestoexport")
        .Name = "Fiche de planification et de suivi d'un projet_2"
        .FieldNames = False
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = _
        "filetoopen"
        .Refresh BackgroundQuery:=False
    End With
ActiveCell.Offset(1,0).Select
Wend
   
    
End Sub

En vous remerciant pour votre aide (et pour toutes les infos glanées sur le forum!!!)
 
Dernière édition:

michel_m

XLDnaute Accro
Re : Macro importer plage de donnée excel vers excel

Bonjour,

essaies cette macro
conditions: tous les classeurs dans le m^me répertoire
"donneestoexport" ne doit pas comporter de noms de champs sur sa première ligne.

Code:
Const compil As String = "cible.xls" 'fichier de regroupement. nom à adapter
Const plage As String = "donneestoexport" 'plage à copier dans cible
Public chemin As String

Sub chercher()
Dim fichier As String
Dim ligne As Long
'
chemin = ThisWorkbook.Path & "\"
ChDir chemin

Application.ScreenUpdating = False
ligne = 2
fichier = Dir("*.xls")
While fichier <> ""
    If fichier <> compil Then
        extraire fichier, ligne
        ligne = Range("A65536").End(xlUp).Row + 1
    End If
    fichier = Dir
    Wend
End Sub

Sub extraire(fich As String, lig As Long)
Dim source As Object
Dim requete As Object
Dim texte_SQL As String
test = plage
'connexion ADO au fichier
Set source = CreateObject("ADODB.Connection")
    source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & chemin & fich & ";Extended Properties=""Excel 8.0;HDR=no;"";"
    
'exerce la requete ADO sur la donnée à recopier
    texte_SQL = "SELECT * FROM [" & plage & "] "
    Set requete = CreateObject("ADODB.Recordset")
    Set requete = source.Execute(texte_SQL)
    
'recopie les données du fichier
    Cells(lig, 1).CopyFromRecordset requete

'f'erme la connexion ADO
Set requete = Nothing
Set source = Nothing

End Sub

ci joint tite demo
 

Pièces jointes

  • xld_juin09.zip
    17.1 KB · Affichages: 166

boross3

XLDnaute Nouveau
Re : Macro importer plage de donnée excel vers excel

Re bonjour,
j'aurais une autre question, si ce n'est trop demander...
Est il possible de connaitre le nombre de ligne de la plage de donnée une fois la requete effectuée, et ce afin de pouvoir créer le nombre de lignes nécessaire pour insérer la plage de donnée?

Encore merci!
 

michel_m

XLDnaute Accro
Re : Macro importer plage de donnée excel vers excel

Je t'avoue que je ne comprend pas trop ta demande car tu as écrit que c'était toujours la m^me plage que tu importais...
Enfin, c'est pas trop dur à faire soit par une boucle soit par une nouvelle requête.

tu veux insérer des lignes, c'est ça?
1/vaut mieux éviter ce genre de truc et utiliser un onglet réservé uniquement à l'importation;
2/ l'importation est différente de la méthode MS query qui, elle, insère des lignes en créant des catas dans les formules à droite et dessous, expérience personnelle pas triste)

donc, si tu y tiens, dis le, je te modifierais la proc
 

boross3

XLDnaute Nouveau
Re : Macro importer plage de donnée excel vers excel

En fait ma plage de donnée est une plage nommée qui n'a pas toujours le même nombre de lignes. Je m'en suis sorti en insérant un grand nombre de ligne avant et en supprimant les lignes en trop apres.. C'est du bricolage, mais ça fonctionne!
Je te remercie, mais pas la peine de te replonger dedans!

Une question pour ma culture personnelle: quelle est la différence entre la connexion OLEDB que j'utilisais et la connexion ADODB que tu proposes? Je vois que l'on perd le processus d'actualisation des données, mais après...

Merci et bonne soirée,
 

boross3

XLDnaute Nouveau
Re : Macro importer plage de donnée excel vers excel

Hé merci pour ce lien, la question était pertinente!

A tout hasard, en cherchant autre chose, je suis tombé sur ça
HTML:
http://forum.hardware.fr/hfr/Programmation/VB-VBA-VBS/excel-recuperer-cellules-sujet_90232_1.htm
, qui propose une méthode "plus classique" à base de ExecuteExcel4Macro, (si j'ai bien compris!)

Bonne soirée,
 

michel_m

XLDnaute Accro
Re : Macro importer plage de donnée excel vers excel

re,

Cette macro dite de Walkenbach est valable si tu as peu de cellules à importer: c'est le cas dans le lien (avec ses solutions monstrueuses...)

Tu pourras la trouver dans le Wiki page 6 de MichelXLD sur ce siteXLD ainsi que des tas de démos sur les classeurs fermés et Access dont un exemple de transfert de tableaux, même discontinus fait en équipe (Thierry, Michel_XLD et ma pomme)

cordialement,
 

Discussions similaires

Statistiques des forums

Discussions
312 514
Messages
2 089 227
Membres
104 072
dernier inscrit
Jeff68